|
|
|
For developers not familiar with the nature of the functions exported by ShlWAPI.dll
and/or for those interested exclusively in the practical aspects,
this page contains the listings of two complete, Delphi 5 projects.
TestShlWAPIFunctions3 Example Project
This project exemplifies the functionality of approximately 50
ShlWAPI.dll functions in form of a Graphical User Interfaace (GUI) application.
It was designed so that all or only specific functions
are called.
The ouput generated by each function is written directly into a TMemo instance
on the main form/window and can be used for reference purposes when the application
is run outside the IDE.
| Project File List |
| |
| File Type: |
File Name: |
| Delphi 5 Project Configuration File (.cfg): |
TestShlWAPIFunctions3.cfg |
| Delphi 5 Options File (.dof): |
TestShlWAPIFunctions3.dof |
| Delphi 5 Project File (.dpr): |
TestShlWAPIFunctions3.dpr |
| Delphi 5 Unit (.pas): |
TestShlWAPIFunctionsMain03.pas |
| Delphi 5 Form (.dfm): |
TestShlWAPIFunctionsMain03.dfm |
| Graphics Interchange Format test image (.gif): |
Delphi5Ico.gif |
| Application Manifest File (.xml): |
TestShlWAPIFunctions3.xml |
| Resource Script File (.rc): |
TestShlWAPIFunctions3.rc |
| Compiled Resource File (.res): |
TestShlWAPIFunctions3.res |
|
| |
Download file
|
|
|
| Project Configuration File |
| |
-$A+
-$B+
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O-
-$P+
-$Q+
-$R+
-$S-
-$T-
-$U+
-$V-
-$W-
-$X+
-$Y+
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H-
-W+
-M
-$M16384,1048576
-K$00400000
-E"Exe\"
-N"Lib\"
-LE"..\..\..\Libraries\SST\Packages"
-LN"..\..\..\Libraries\SST\Packages"
-U"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;"
-O"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;"
-I"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;"
-R"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;" |
| |
Download file
|
|
|
| Delphi Options File |
| |
[Compiler]
A=1
B=1
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=0
P=1
Q=1
R=1
S=0
T=0
U=1
V=0
W=0
X=1
Y=2
Z=1
ShowHints=0
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=Exe\
UnitOutputDir=Lib\
PackageDLLOutputDir=Packages\
PackageDCPOutputDir=Packages\
SearchPath=$(DELPHI)\Lib\Debug;$(DELPHI)\Projects\Pas;$(DELPHI)\Projects\Lib;Pas;Lib;
Packages=Vcl50;Vclx50;VclSmp50;Vcldb50;Vclbde50;vcldbx50;VCLIB50;vclie50;dclocx50;dclaxserver50;
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Stoelzel Software Technologie (SST)
FileDescription=ShlWAPI.dll Function Usage Application.
FileVersion=1.16.0.0
InternalName=TestShlWAPIFunctions3.exe
LegalCopyright=Stoelzel Software Technologie (SST) 2017
LegalTrademarks=
OriginalFilename=TestShlWAPIFunctions3.exe
ProductName=(SST) ShlWAPI.pas Version 1.08
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
$(DELPHI)\Extras\NetManage\DCLISP20.BPL=Borland Internet Solutions Pack Components (2.0 Compatability)
$(DELPHI)\Bin\dclite50.bpl=Borland Integrated Translation Environment
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=1
Item0=$(DELPHI)\Lib\Debug;$(DELPHI)\Projects\Pas;$(DELPHI)\Projects\Lib
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=Lib\
[HistoryLists\hlOutputDirectorry]
Count=1
Item0=Exe\
[HistoryLists\hlBPLOutput]
Count=0
[HistoryLists\hlDCPOutput]
Count=0 |
| |
Download file
|
|
|
| Project Source Code |
| |
program TestShlWAPIFunctions3;
uses
Forms,
TestShlWAPIFunctionsMain03 in 'Pas\TestShlWAPIFunctionsMain03.pas' {Form4};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm4, Form4);
Application.Run;
end. |
| |
Download file
|
|
|
| Application Main Window Unit |
| |
{*****************************************************************************}
{ UNIT TestShlWAPIFunctionsMain03.pas }
{ Copyright © Stoelzel Software Technologie 2015 }
{ }
{ Author: Dominic Stoelzel }
{ Version : 1.18 }
{ Created : June 04, 2015 }
{ Last modified : June 01, 2018, 05:45 (ds) }
{ }
{ Description of contents : Declares and implements the main window class }
{ and utility functions of the SST application that tests the functionality }
{ of the declarations of the (SST) ShlWAPI import implementation of the }
{ functions exported by the Windows shell, dynamic link library (dll) }
{ ShlWAPI.dll. }
{ }
{ Note : . }
{ }
{*****************************************************************************}
unit TestShlWAPIFunctionsMain03;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ComCtrls, ExtCtrls, ShlWAPI;
CONST SAMPLE_MAJORVERSION = 1;
CONST SAMPLE_MINORVERSION = 3;
CONST SAMPLE_BUILDNUMBER = 42;
CONST SAMPLE_QFE = 88;
//List View Function Name Item Index Constants
CONST C_ASSOCGETPERCEIVEDTYPE_LVID = 1;
CONST C_COLORADJUSTLUMA_LVID = 11;
CONST C_COLORHLSTORGB_LVID = 12;
CONST C_COLORRGBTOHLS_LVID = 13;
CONST C_DLLGETVERSION_LVID = 16;
CONST C_GETACCEPTLANGUAGES_LVID = 17;
CONST C_ISINTERNETESCENABLED_LVID = 25;
CONST C_ISOS_LVID = 26;
CONST C_MLFREELIBRARY_LVID = 42;
CONST C_MLLOADLIBRARY_LVID = 43;
CONST C_PATHADDEXTENSION_LVID = 49;
CONST C_PATHCOMBINE_LVID = 57;
CONST C_PATHCREATEFROMURL_LVID = 65;
CONST C_PATHFILEEXISTS_LVID = 68;
CONST C_PATHFINDNEXTCOMPONENT_LVID = 74;
CONST C_PATHFINDONPATH_LVID = 77;
CONST C_PATHFINDSUFFIXARRAY_LVID = 78;
CONST C_PATHGETARGS_LVID = 80;
CONST C_PATHGETDRIVENUMBER_LVID = 84;
CONST C_PATHISDIRECTORY_LVID = 88;
CONST C_PATHISLFNFILESPEC_LVID = 94;
CONST C_PATHISROOT_LVID = 102;
CONST C_PATHISSYSTEMFOLDER_LVID = 106;
CONST C_PATHISUNC_LVID = 108;
CONST C_PARSEURL_LVID = 114;
CONST C_PATHMAKEPRETTY_LVID = 116;
CONST C_PATHQUOTESPACES_LVID = 126;
CONST C_PATHSEARCHANDQUALIFY_LVID = 142;
CONST C_PATHUNQUOTESPACES_LVID = 158;
CONST C_SHCREATESHELLPALETTE_LVID = 168;
CONST C_SHFORMATDATETIME_LVID = 189;
CONST C_SHMESSAGEBOXCHECK_LVID = 201;
CONST C_SHSTRIPMNEUMONIC_LVID = 256;
CONST C_STRFORMATBYTESIZEA_LVID = 295;
CONST C_STRFORMATBYTESIZEW_LVID = 296;
CONST C_STRFORMATBYTESIZE64A_LVID = 294;
CONST C_STRFORMATBYTESIZEEX_LVID = 297;
CONST C_STRFORMATKBSIZE_LVID = 298;
CONST C_STRFROMTIMEINTERVAL_LVID = 300;
CONST C_STRTOINT64EX_LVID = 327;
CONST C_STRTOINT_LVID = 329;
CONST C_STRTOINTEX_LVID = 331;
CONST C_STRCSPN_LVID = 288;
CONST C_STRSPN_LVID = 319;
CONST C_WHICHPLATFORMF_LVID = 362;
CONST C_WVNSPRINTF_LVID = 365;
CONST C_FINDRESOURCEWRAPW_LVID = 369;
CONST C_OUTPUTDEBUGSTRINGWRAPW_LVID = 370;
//Ported, ShlWAPI Macros
CONST C_MAKEDLLVERULL_LVID = 371;
type TForm4 = class(TForm)
MainMenu1: TMainMenu;
MainMenuFile: TMenuItem;
MMFileOpen: TMenuItem;
MMFileSep1: TMenuItem;
MMFileListSampleFunctions: TMenuItem;
MMFileRunFunctionTests: TMenuItem;
MMFileSep2: TMenuItem;
MMFileSaveAs: TMenuItem;
MMFileSep3: TMenuItem;
MMFileExit: TMenuItem;
MainMenuEdit: TMenuItem;
MMeditUndo: TMenuItem;
MMEditSep1: TMenuItem;
MMEditCut: TMenuItem;
MMEditCopy: TMenuItem;
MMEditPaste: TMenuItem;
MMEditDelete: TMenuItem;
MMEditSep2: TMenuItem;
MMEditSelAll: TMenuItem;
MMEditClearSel: TMenuItem;
MMEditCheckSel: TMenuItem;
MMeditUnCheckSel: TMenuItem;
MMEditSep3: TMenuItem;
MMEditAddAnsiFunction: TMenuItem;
MMEditAddWCHARFunctionName: TMenuItem;
MMEditAddBothBunctkionNames: TMenuItem;
MMEditSep4: TMenuItem;
MMEditFind: TMenuItem;
MMEditFindNext: TMenuItem;
MainMenuView: TMenuItem;
MainMenuOptions: TMenuItem;
MainMenuHelp: TMenuItem;
MMHelpHelp: TMenuItem;
MMHelpSeparator1: TMenuItem;
MMHelpAbout: TMenuItem;
Panel1: TPanel;
StaticText1: TStaticText;
SelFileComboBox1: TComboBox;
BrowseButton1: TButton;
Panel2: TPanel;
ListView1: TListView;
TestFunctionButton1: TButton;
Splitter1: TSplitter;
Panel3: TPanel;
Memo1: TMemo;
StatusBar1: TStatusBar;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
FindDialog1: TFindDialog;
private
{ Private declarations }
PROTECTED
fmlresmoduleh : HMODULE; //Member var for MLLoadLibrary and MLFreeLibrary
FUNCTION GetDllHandle(adllanme : STRING) : HMODULE;
FUNCTION IsDllVerInfoImplemted(adllhandle : HMODULE; VAR aprocaddr : POINTER) : BOOLEAN;
FUNCTION GetDllVersionInfoVer(aprocaddr : POINTER; VAR adllverinforec : TDllVersionInfo2) : INTEGER;
FUNCTION GetDllVersionInfo(aprocaddr : POINTER; VAR adllverinforec : TDllVersionInfo) : BOOLEAN;
FUNCTION GetDllVersionInfo2(aprocaddr : POINTER; VAR adllverinforec : TDllVersionInfo2) : BOOLEAN;
public
{ Public declarations }
PUBLISHED
PROCEDURE OnCreate(Sender : TObject);
PROCEDURE SelectAllFunctions(Sender : TObject);
PROCEDURE DeselectAllFunctions(Sender : TObject);
PROCEDURE TestSelectedFunction(Sender : TObject);
PROCEDURE TestDllGetVersion(Sender : TObject);
PROCEDURE TestExampleDllGetVersion(Sender : TObject);
PROCEDURE TestMakeDllVerULL1(Sender : TObject);
PROCEDURE TestShlWAPIStrToInt64Ex(Sender : TObject);
PROCEDURE TestShlWAPIStrToInt(Sender : TObject);
PROCEDURE TestShlWAPIStrToIntEx(Sender : TObject);
PROCEDURE TestShlWAPISHCreateShellPalette(Sender : TObject);
PROCEDURE TestShlWAPISHFormatDateTime(Sender : TObject);
PROCEDURE TestShlWAPIStrFromTimeInterval(Sender : TObject);
PROCEDURE TestShlWAPIStrFormatKBSize(Sender : TObject);
PROCEDURE TestShlWAPIStrFormatByteSizeA(Sender : TObject);
PROCEDURE TestShlWAPIStrFormatByteSizeW(Sender : TObject);
PROCEDURE TestShlWAPIStrFormatByteSize64A(Sender : TObject);
PROCEDURE TestShlWAPIStrFormatByteSizeEx(Sender : TObject);
PROCEDURE TestShlWAPIStrCSpn(Sender : TObject);
PROCEDURE TestShlWAPIStrSpn(Sender : TObject);
PROCEDURE TestShlWAPIMLFreeLibrary(Sender : TObject);
PROCEDURE TestShlWAPIMLLoadLibrary(Sender : TObject);
PROCEDURE TestShlWAPIPathAddExtension(Sender : TObject);
PROCEDURE TestShlWAPIPathCombine(Sender : TObject);
PROCEDURE TestShlWAPIPathCreateFromUrl(Sender : TObject);
PROCEDURE TestShlWAPIPathFileExists(Sender : TObject);
PROCEDURE TestShlWAPIPathFindNextComponent(Sender : TObject);
PROCEDURE TestShlWAPIPathFindOnPath(Sender : TObject);
PROCEDURE TestShlWAPIPathFindSuffixArray(Sender : TObject);
PROCEDURE TestShlWAPIPathGetArgs(Sender : TObject);
PROCEDURE TestShlWAPIPathGetDriveNumber(Sender : TObject);
PROCEDURE TestShlWAPIPathPathIsDirectory(Sender : TObject);
PROCEDURE TestShlWAPIPathIsLFNFileSpec(Sender : TObject);
PROCEDURE TestShlWAPIPathIsRoot(Sender : TObject);
PROCEDURE TestShlWAPIPathIsUNC(Sender : TObject);
PROCEDURE TestShlWAPIParseURL(Sender : TObject);
PROCEDURE TestShlWAPIPathIsSystemFolder(Sender : TObject);
PROCEDURE TestShlWAPIPathSearchAndQualify(Sender : TObject);
PROCEDURE TestShlWAPIPathQuoteSpaces(Sender : TObject);
PROCEDURE TestShlWAPIPPathUnquoteSpaces(Sender : TObject);
PROCEDURE TestShlWAPIPathMakePretty(Sender : TObject);
PROCEDURE TestShlWAPIGetAcceptLanguages(Sender : TObject);
PROCEDURE TestShlWAPIColorAdjustLuma(Sender : TObject);
PROCEDURE TestShlWAPIColorHLSToRGB(Sender : TObject);
PROCEDURE TestShlWAPIColorRGBToHLS(Sender : TObject);
PROCEDURE TestShlWAPIwvnsprintf(Sender : TObject);
PROCEDURE TestShlWAPIWhichPlatform(Sender : TObject);
PROCEDURE TestShlWAPIIsInternetESCEnabled(Sender : TObject);
PROCEDURE TestShlWAPIIsOS(Sender : TObject);
PROCEDURE TestShlWAPIAssocGetPerceivedType(Sender : TObject);
PROCEDURE TestShlWAPISHMessageBoxCheck(Sender : TObject);
PROCEDURE TestShlWAPISHStripMneumonic(Sender : TObject);
PROCEDURE TestFindResourceWrapW(Sender : TObject);
PROCEDURE TestShlWAPIOutputDebugStringWrapW(Sender : TObject);
PROCEDURE ListExampleFunctions(Sender : TObject);
PROCEDURE FindText(Sender : TObject);
PROCEDURE OnFindDialogFind(Sender : TObject);
PROCEDURE ExitApplication(Sender: TObject);
end;
var Form4: TForm4;
implementation
//USES ;
{$R *.DFM}
{$RESOURCE ..\Res\TestShlWAPIFunctions3.res}
PROCEDURE TForm4.OnCreate(Sender : TObject);
VAR numlvitems : INTEGER;
VAR lvitem : TListItem;
VAR functionname : STRING;
VAR i : INTEGER;
BEGIN
fmlresmoduleh := 0;
numlvitems := 0;
lvitem := NIL;
functionname := '';
i := 0;
numlvitems := ListView1.Items.Count;
IF numlvitems > 0 THEN
BEGIN
//Once we've implemented all functions we can use the following loop.
FOR i := 0 TO numlvitems - 1 DO
BEGIN
lvitem := ListView1.Items.Item[i];
lvitem.Caption := IntToStr(i) + ' ' + lvitem.Caption;
//lvitem.Checked := TRUE;
END;
//Until then, however, we'll explicitly check only those functions
//we've already implemented.
ListView1.Items[C_ASSOCGETPERCEIVEDTYPE_LVID].Checked := TRUE;
ListView1.Items[C_COLORADJUSTLUMA_LVID].Checked := TRUE;
ListView1.Items[C_COLORHLSTORGB_LVID].Checked := TRUE;
ListView1.Items[C_COLORRGBTOHLS_LVID].Checked := TRUE;
ListView1.Items[C_DLLGETVERSION_LVID].Checked := TRUE;
ListView1.Items[C_GETACCEPTLANGUAGES_LVID].Checked := TRUE;
ListView1.Items[C_ISOS_LVID].Checked := TRUE;
ListView1.Items[C_MLFREELIBRARY_LVID].Checked := TRUE;
ListView1.Items[C_MLLOADLIBRARY_LVID].Checked := TRUE;
ListView1.Items[C_PATHADDEXTENSION_LVID].Checked := TRUE;
ListView1.Items[C_PATHCOMBINE_LVID].Checked := TRUE;
ListView1.Items[C_PATHCREATEFROMURL_LVID].Checked := TRUE;
ListView1.Items[C_PATHFILEEXISTS_LVID].Checked := TRUE;
ListView1.Items[C_PATHFINDNEXTCOMPONENT_LVID].Checked := TRUE;
ListView1.Items[C_PATHFINDONPATH_LVID].Checked := TRUE;
ListView1.Items[C_PATHFINDSUFFIXARRAY_LVID].Checked := TRUE;
ListView1.Items[C_PATHGETARGS_LVID].Checked := TRUE;
ListView1.Items[C_PATHGETDRIVENUMBER_LVID].Checked := TRUE;
ListView1.Items[C_PATHISDIRECTORY_LVID].Checked := TRUE;
ListView1.Items[C_PATHISLFNFILESPEC_LVID].Checked := TRUE;
ListView1.Items[C_PATHISROOT_LVID].Checked := TRUE;
ListView1.Items[C_PATHISSYSTEMFOLDER_LVID].Checked := TRUE;
ListView1.Items[C_PATHISUNC_LVID].Checked := TRUE;
ListView1.Items[C_PARSEURL_LVID].Checked := TRUE;
ListView1.Items[C_PATHMAKEPRETTY_LVID].Checked := TRUE;
ListView1.Items[C_PATHQUOTESPACES_LVID].Checked := TRUE;
ListView1.Items[C_PATHSEARCHANDQUALIFY_LVID].Checked := TRUE;
ListView1.Items[C_PATHUNQUOTESPACES_LVID].Checked := TRUE;
ListView1.Items[C_SHCREATESHELLPALETTE_LVID].Checked := TRUE;
ListView1.Items[C_SHFORMATDATETIME_LVID].Checked := TRUE;
ListView1.Items[C_SHMESSAGEBOXCHECK_LVID].Checked := TRUE;
ListView1.Items[C_SHSTRIPMNEUMONIC_LVID].Checked := TRUE;
ListView1.Items[C_STRFORMATBYTESIZEA_LVID].Checked := TRUE;
ListView1.Items[C_STRFORMATBYTESIZEW_LVID].Checked := TRUE;
ListView1.Items[C_STRFORMATBYTESIZE64A_LVID].Checked := TRUE;
ListView1.Items[C_STRFORMATBYTESIZEEX_LVID].Checked := TRUE;
ListView1.Items[C_STRFORMATKBSIZE_LVID].Checked := TRUE;
ListView1.Items[C_STRCSPN_LVID].Checked := TRUE;
ListView1.Items[C_STRSPN_LVID].Checked := TRUE;
ListView1.Items[C_STRFROMTIMEINTERVAL_LVID].Checked := TRUE;
ListView1.Items[C_STRTOINT64EX_LVID].Checked := TRUE;
ListView1.Items[C_STRTOINT_LVID].Checked := TRUE;
ListView1.Items[C_STRTOINTEX_LVID].Checked := TRUE;
ListView1.Items[C_WHICHPLATFORMF_LVID].Checked := TRUE;
ListView1.Items[C_WVNSPRINTF_LVID].Checked := TRUE;
ListView1.Items[C_FINDRESOURCEWRAPW_LVID].Checked := TRUE;
ListView1.Items[C_OUTPUTDEBUGSTRINGWRAPW_LVID].Checked := TRUE;
//Ported, ShlWAPI Macros
ListView1.Items[C_MAKEDLLVERULL_LVID].Checked := TRUE;
END;
//ELSE
END;
PROCEDURE TForm4.SelectAllFunctions(Sender : TObject);
VAR numlvitems : INTEGER;
VAR lvitem : TListItem;
VAR i : INTEGER;
BEGIN
//kaldjfaksdfj
numlvitems := 0;
lvitem := NIL;
i := 0;
numlvitems := ListView1.Items.Count;
IF numlvitems > 0 THEN
BEGIN
FOR i := 0 TO numlvitems - 1 DO
BEGIN
lvitem := ListView1.Items.Item[i];
lvitem.Checked := TRUE;
END;
END;
//ELSE //Show an error message
END;
PROCEDURE TForm4.DeselectAllFunctions(Sender : TObject);
VAR numlvitems : INTEGER;
VAR lvitem : TListItem;
VAR i : INTEGER;
BEGIN
//kaldjfaksdfj
numlvitems := 0;
lvitem := NIL;
i := 0;
numlvitems := ListView1.Items.Count;
IF numlvitems > 0 THEN
BEGIN
FOR i := 0 TO numlvitems - 1 DO
BEGIN
lvitem := ListView1.Items.Item[i];
lvitem.Checked := FALSE;
END;
END;
//ELSE //Show an error message
END;
PROCEDURE TForm4.TestSelectedFunction(Sender : TObject);
VAR numlvitems : INTEGER;
VAR newinfoline : STRING;
BEGIN
numlvitems := 0;
newinfoline := '';
//dlgitemid := GetDlgCtrlID(StaticText1.Handle);
numlvitems := ListView1.Items.Count;
IF numlvitems > 0 THEN
BEGIN
newinfoline := '';
newinfoline := 'The following lines demonstrate the output/return values generated ' +
'by example calls to the checked ShlWAPi.dll functions.';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
//GetDllVersionInfoVer('ShlWAPI.dll');
IF ListView1.Items[C_ASSOCGETPERCEIVEDTYPE_LVID].Checked THEN
TestShlWAPIAssocGetPerceivedType(Sender);
IF ListView1.Items[C_COLORADJUSTLUMA_LVID].Checked THEN
TestShlWAPIColorAdjustLuma(Sender);
IF ListView1.Items[C_COLORHLSTORGB_LVID].Checked THEN
TestShlWAPIColorHLSToRGB(Sender);
IF ListView1.Items[C_COLORRGBTOHLS_LVID].Checked THEN
TestShlWAPIColorRGBToHLS(Sender);
IF ListView1.Items[C_DLLGETVERSION_LVID].Checked THEN
TestDllGetVersion(Sender);
IF ListView1.Items[C_GETACCEPTLANGUAGES_LVID].Checked THEN
TestShlWAPIGetAcceptLanguages(Sender);
IF ListView1.Items[C_ISINTERNETESCENABLED_LVID].Checked THEN
TestShlWAPIIsInternetESCEnabled(Sender);
IF ListView1.Items[C_ISOS_LVID].Checked THEN
TestShlWAPIIsOS(Sender);
IF ListView1.Items[C_MLFREELIBRARY_LVID].Checked THEN
TestShlWAPIMLFreeLibrary(Sender);
IF ListView1.Items[C_MLLOADLIBRARY_LVID].Checked THEN
TestShlWAPIMLLoadLibrary(Sender);
IF ListView1.Items[C_PATHADDEXTENSION_LVID].Checked THEN
TestShlWAPIPathAddExtension(Sender);
IF ListView1.Items[C_PATHCOMBINE_LVID].Checked THEN
TestShlWAPIPathCombine(Sender);
IF ListView1.Items[C_PATHCREATEFROMURL_LVID].Checked THEN
TestShlWAPIPathCreateFromUrl(Sender);
IF ListView1.Items[C_PATHFILEEXISTS_LVID].Checked THEN
TestShlWAPIPathFileExists(Sender);
IF ListView1.Items[C_PATHFINDNEXTCOMPONENT_LVID].Checked THEN
TestShlWAPIPathFindNextComponent(Sender);
IF ListView1.Items[C_PATHFINDONPATH_LVID].Checked THEN
TestShlWAPIPathFindOnPath(Sender);
IF ListView1.Items[C_PATHFINDSUFFIXARRAY_LVID].Checked THEN
TestShlWAPIPathFindSuffixArray(Sender);
IF ListView1.Items[C_PATHGETARGS_LVID].Checked THEN
TestShlWAPIPathGetArgs(Sender);
IF ListView1.Items[C_PATHGETDRIVENUMBER_LVID].Checked THEN
TestShlWAPIPathGetDriveNumber(Sender);
IF ListView1.Items[C_PATHISDIRECTORY_LVID].Checked THEN
TestShlWAPIPathPathIsDirectory(Sender);
IF ListView1.Items[C_PATHISLFNFILESPEC_LVID].Checked THEN
TestShlWAPIPathIsLFNFileSpec(Sender);
IF ListView1.Items[C_PATHISROOT_LVID].Checked THEN
TestShlWAPIPathIsRoot(Sender);
IF ListView1.Items[C_PATHISSYSTEMFOLDER_LVID].Checked THEN
TestShlWAPIPathIsSystemFolder(Sender);
IF ListView1.Items[C_PATHISUNC_LVID].Checked THEN
TestShlWAPIPathIsUNC(Sender);
IF ListView1.Items[C_PARSEURL_LVID].Checked THEN
TestShlWAPIParseURL(Sender);
IF ListView1.Items[C_PATHMAKEPRETTY_LVID].Checked THEN
TestShlWAPIPathMakePretty(Sender);
IF ListView1.Items[C_PATHQUOTESPACES_LVID].Checked THEN
TestShlWAPIPathQuoteSpaces(Sender);
IF ListView1.Items[C_PATHSEARCHANDQUALIFY_LVID].Checked THEN
TestShlWAPIPathSearchAndQualify(Sender);
IF ListView1.Items[C_PATHUNQUOTESPACES_LVID].Checked THEN
TestShlWAPIPPathUnquoteSpaces(Sender);
IF ListView1.Items[C_SHCREATESHELLPALETTE_LVID].Checked THEN
TestShlWAPISHCreateShellPalette(Sender);
IF ListView1.Items[C_SHFORMATDATETIME_LVID].Checked THEN
TestShlWAPISHFormatDateTime(Sender);
IF ListView1.Items[C_SHMESSAGEBOXCHECK_LVID].Checked THEN
TestShlWAPISHMessageBoxCheck(Sender);
IF ListView1.Items[C_SHSTRIPMNEUMONIC_LVID].Checked THEN
TestShlWAPISHStripMneumonic(Sender);
IF ListView1.Items[C_STRFORMATBYTESIZEA_LVID].Checked THEN
TestShlWAPIStrFormatByteSizeA(Sender);
IF ListView1.Items[C_STRFORMATBYTESIZEW_LVID].Checked THEN
TestShlWAPIStrFormatByteSizeW(Sender);
IF ListView1.Items[C_STRFORMATBYTESIZE64A_LVID].Checked THEN
TestShlWAPIStrFormatByteSize64A(Sender);
IF ListView1.Items[C_STRFORMATBYTESIZEEX_LVID].Checked THEN
TestShlWAPIStrFormatByteSizeEx(Sender);
IF ListView1.Items[C_STRFORMATKBSIZE_LVID].Checked THEN
TestShlWAPIStrFormatKBSize(Sender);
IF ListView1.Items[C_STRFROMTIMEINTERVAL_LVID].Checked THEN
TestShlWAPIStrFromTimeInterval(Sender);
IF ListView1.Items[C_STRTOINT64EX_LVID].Checked THEN
TestShlWAPIStrToInt64Ex(Sender);
IF ListView1.Items[C_STRTOINT_LVID].Checked THEN
TestShlWAPIStrToInt(Sender);
IF ListView1.Items[C_STRTOINTEX_LVID].Checked THEN
TestShlWAPIStrToIntEx(Sender);
IF ListView1.Items[C_STRCSPN_LVID].Checked THEN
TestShlWAPIStrCSpn(Sender);
IF ListView1.Items[C_STRSPN_LVID].Checked THEN
TestShlWAPIStrSpn(Sender);
IF ListView1.Items[C_WHICHPLATFORMF_LVID].Checked THEN
TestShlWAPIWhichPlatform(Sender);
IF ListView1.Items[C_WVNSPRINTF_LVID].Checked THEN
TestShlWAPIwvnsprintf(Sender);
IF ListView1.Items[C_FINDRESOURCEWRAPW_LVID].Checked THEN
TestFindResourceWrapW(sender);
IF ListView1.Items[C_OUTPUTDEBUGSTRINGWRAPW_LVID].Checked THEN
TestShlWAPIOutputDebugStringWrapW(sender);
//Ported, ShlWAPI Macros
IF ListView1.Items[C_MAKEDLLVERULL_LVID].Checked THEN
TestMakeDllVerULL1(sender);
END;
//ELSE //Show an error message
END;
PROCEDURE TForm4.TestDllGetVersion(Sender : TObject);
//quick fix engineering (QFE)
VAR dllhandle : HMODULE;
VAR verinfosupported : BOOLEAN;
VAR procaddr : POINTER;
VAR dllverinfover : INTEGER;
VAR dllverinfo2rec : TDllVersionInfo2;
VAR getverretval : BOOLEAN;
VAR ullversionval : WORD;
VAR newinfoline : STRING;
BEGIN
dllhandle := 0;
verinfosupported := FALSE;
procaddr := NIL;
dllverinfover := 0;
FillChar(dllverinfo2rec, SizeOf(dllverinfo2rec), #0);
getverretval := FALSE;
newinfoline := '';
dllhandle := GetDllHandle('ShlWAPI.dll');
verinfosupported := IsDllVerInfoImplemted(dllhandle, procaddr);
IF verinfosupported THEN
BEGIN
dllverinfover := GetDllVersionInfoVer(procaddr, dllverinfo2rec);
IF dllverinfover >= 1 THEN
BEGIN
newinfoline := 'The loaded ShlWAPI.dll supports DllGetVersion, version ' + IntToStr(dllverinfover) +
' records';
Memo1.Lines.Add(newinfoline);
IF dllverinfover = 1 THEN
getverretval := GetDllVersionInfo(procaddr, dllverinfo2rec.info1)
ELSE
IF dllverinfover = 2 THEN
getverretval := GetDllVersionInfo2(procaddr, dllverinfo2rec);
IF getverretval = TRUE THEN
BEGIN
newinfoline := 'DllGetVersion returned the following version information: ';
Memo1.Lines.Add(newinfoline);
newinfoline := 'Major version : ' + IntToStr(dllverinfo2rec.info1.dwMajorVersion);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Minor version : ' + IntToStr(dllverinfo2rec.info1.dwMinorVersion);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Build number : ' + IntToStr(dllverinfo2rec.info1.dwBuildNumber);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Platform ID : ' + IntToStr(dllverinfo2rec.info1.dwPlatformID);
Memo1.Lines.Add(newinfoline);
IF dllverinfover = 2 THEN
BEGIN
newinfoline := 'ullVersion : 0x' + IntToHex(dllverinfo2rec.ullVersion, 16);
Memo1.Lines.Add(newinfoline);
newinfoline := 'ullVersion broken down into : ';
Memo1.Lines.Add(newinfoline);
//Make the unwieldy term on the right a little easier to handle
ullversionval := HIWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).HighPart);
newinfoline := 'Major version : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
ullversionval := LOWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).HighPart);
newinfoline := 'Minor version : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
ullversionval := HIWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).LowPart);
newinfoline := 'Build number : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
ullversionval := LOWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).LowPart);
newinfoline := 'QFE : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
//Test the SST MakeDllVerULL implementation
FillChar(dllverinfo2rec, SizeOf(dllverinfo2rec), #0);
dllverinfo2rec.ullVersion := Int64(MakeDllVerULL(6, 0, 6001, 18000));
newinfoline := 'ullVersion : 0x' + IntToHex(dllverinfo2rec.ullVersion, 16);
Memo1.Lines.Add(newinfoline);
END;
END
ELSE
BEGIN
newinfoline := 'Retrieving the version information failed';
Memo1.Lines.Add(newinfoline);
END;
END
ELSE
BEGIN
newinfoline := 'Determining the version of the version info record supported by DllGetVersion failed.';
Memo1.Lines.Add(newinfoline);
END;
END
ELSE
BEGIN
newinfoline := 'The loaded ShlWAPI.dll does not support DllGetVersion';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('');
TestExampleDllGetVersion(Sender);
END;
PROCEDURE TForm4.TestExampleDllGetVersion(Sender : TObject);
VAR dllhandle : HMODULE;
VAR verinfosupported : BOOLEAN;
VAR procaddr : POINTER;
VAR dllverinfover : INTEGER;
VAR dllverinfo2rec : TDllVersionInfo2;
VAR getverretval : BOOLEAN;
VAR ullversionval : WORD;
VAR newinfoline : STRING;
VAR dllgetverfp : TDllGetVersionProc;
VAR dllgetverresult : HRESULT;
BEGIN
dllhandle := 0;
verinfosupported := FALSE;
procaddr := NIL;
dllverinfover := 0;
FillChar(dllverinfo2rec, SizeOf(dllverinfo2rec), #0);
getverretval := FALSE;
newinfoline := '';
dllhandle := LoadLibrary('MyExampleDll01.dll');
verinfosupported := IsDllVerInfoImplemted(dllhandle, procaddr);
IF verinfosupported THEN
BEGIN
dllverinfover := GetDllVersionInfoVer(procaddr, dllverinfo2rec);
dllgetverresult := 0;
dllgetverfp := GetProcAddress(dllhandle, 'DllGetVersion');
IF @dllgetverfp <> NIL THEN
dllgetverresult := dllgetverfp(@dllverinfo2rec.info1);
IF dllverinfover >= 1 THEN
BEGIN
newinfoline := 'The loaded MyExampleDll01.dll supports DllGetVersion, version ' + IntToStr(dllverinfover) +
' records';
Memo1.Lines.Add(newinfoline);
IF dllverinfover = 1 THEN
getverretval := GetDllVersionInfo(procaddr, dllverinfo2rec.info1)
ELSE
IF dllverinfover = 2 THEN
getverretval := GetDllVersionInfo2(procaddr, dllverinfo2rec);
IF getverretval = TRUE THEN
BEGIN
newinfoline := 'DllGetVersion returned the following version information: ';
Memo1.Lines.Add(newinfoline);
newinfoline := 'Major version : ' + IntToStr(dllverinfo2rec.info1.dwMajorVersion);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Minor version : ' + IntToStr(dllverinfo2rec.info1.dwMinorVersion);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Build number : ' + IntToStr(dllverinfo2rec.info1.dwBuildNumber);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Platform ID : ' + IntToStr(dllverinfo2rec.info1.dwPlatformID);
Memo1.Lines.Add(newinfoline);
IF dllverinfover = 2 THEN
BEGIN
newinfoline := 'ullVersion : 0x' + IntToHex(dllverinfo2rec.ullVersion, 16);
Memo1.Lines.Add(newinfoline);
newinfoline := 'ullVersion broken down into : ';
Memo1.Lines.Add(newinfoline);
//Make the unwieldy term on the right a little easier to handle
ullversionval := HIWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).HighPart);
newinfoline := 'Major version : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
ullversionval := LOWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).HighPart);
newinfoline := 'Minor version : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
ullversionval := HIWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).LowPart);
newinfoline := 'Build number : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
ullversionval := LOWORD(ULARGE_INTEGER(dllverinfo2rec.ullVersion).LowPart);
newinfoline := 'QFE : ' + IntToStr(ullversionval) + ' (0x' + IntToHex(ullversionval, 4) + ')';
Memo1.Lines.Add(newinfoline);
//Test the SST MakeDllVerULL implementation
FillChar(dllverinfo2rec, SizeOf(dllverinfo2rec), #0);
dllverinfo2rec.ullVersion := Int64(MakeDllVerULL(6, 0, 6001, 18000));
newinfoline := 'ullVersion : 0x' + IntToHex(dllverinfo2rec.ullVersion, 16);
Memo1.Lines.Add(newinfoline);
END;
END
ELSE
BEGIN
newinfoline := 'Retrieving the version information failed';
Memo1.Lines.Add(newinfoline);
END;
END
ELSE
BEGIN
newinfoline := 'Determining the version of the version info record supported by DllGetVersion failed.';
Memo1.Lines.Add(newinfoline);
END;
FreeLibrary(dllhandle);
END
ELSE
BEGIN
newinfoline := 'The loaded ShlWAPI.dll does not support DllGetVersion';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestMakeDllVerULL1(Sender : TObject);
VAR versionnum : INT64;
VAR dbgmsg : STRING;
BEGIN
FillChar(versionnum, SizeOf(versionnum), #0);
dbgmsg := '';
versionnum := INT64(MakeDllVerULL(SAMPLE_MAJORVERSION, SAMPLE_MINORVERSION, SAMPLE_BUILDNUMBER, SAMPLE_QFE));
dbgmsg := 'The composite version number of this app is : 0x' + IntToHex(versionnum, 16);
ShowMessage(dbgmsg);
END;
PROCEDURE TForm4.TestShlWAPIStrToInt(Sender : TObject);
VAR numstr : STRING;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
numstr := '';
apiretval := 0;
newinfoline := '';
numstr := IntToStr($FFFFFFFF);
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := FloatToStr(8888.77);
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := FloatToStr(10000.01);
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '202 101';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '-505030';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '-600000,F91';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := 'ESP,F91';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '1 000 000.01';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '1,000,000.01';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '0xAABBCCDD';
numstr := 'AABBCCDD';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
IF apiretval = 0 THEN
apiretval := INTEGER(GetLastError());
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := ' 4200000';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '4200000.2100';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '4200000,2100';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
numstr := '2147483648';
apiretval := ShlWAPI.StrToInt(PChar(numstr));
newinfoline := 'StrToInt called with "' + numstr + '" returned : ';
newinfoline := newinfoline + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := 0;
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrToIntEx(Sender : TObject);
VAR numstr : STRING;
VAR flags : DWORD;
VAR number : INTEGER;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
numstr := '';
flags := 0; //(= STIF_DEFAULT = $00000000;);
number := 0;
apiretval := FALSE;
newinfoline := '';
numstr := '22000';
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '3,300,100';
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '44.127.958';
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := ' 330010';
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := FloatToStr(8888.77);
numstr := '8888.77';
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := IntToHex($FFFFFFFF, 8);
numstr := 'FFFFFFFF';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := IntToHex($AA11BB22, 8);
numstr := 'AA11BB22';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := '0x' + IntToHex($CC33DD44, 8);
numstr := '0xCC33DD44';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := '0X' + IntToHex($EE55FF66, 8);
numstr := '0XEE55FF66';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '88991000';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '0x88991000';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := ' 0X' + IntToHex($AF15BE72, 8);
numstr := ' 0XAF15BE72';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := '-0x' + IntToHex($1B52F104, 8);
numstr := '-0x1B52F104';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//numstr := '$' + IntToHex($1B52F104, 8);
numstr := '$1B52F104';
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := ' -2,2.000'; //Note the TWO leading blanks !
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToIntEx(PChar(numstr), flags, @number);
newinfoline := 'StrToIntEx called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 8) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrToInt64Ex(Sender : TObject);
//IMPORTANT !!! Ordinal is, contrary to first assumption, NOT 327 !!!
VAR numstr : STRING;
VAR wcharnumstr : WideString;
VAR flags : DWORD;
VAR number : TLargeInteger;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
numstr := '';
wcharnumstr := '';
flags := 0; //(= STIF_DEFAULT = $00000000;);
FillChar(number, SizeOf(number), #0);
apiretval := FALSE;
newinfoline := '';
numstr := '440000000000';
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '370,100,200,300'; //US/English thousands sepaators
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '420.300.200.100'; //European thousands sepaators
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := ' 120300200100'; //Leading blank/space
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '-560000123000'; //Negative number, no hex notation
//flags := STIF_DEFAULT; //= 0, set in var initialization
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '-870000321000'; //Negative number, but hex notation permissible
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '0x6FAB0000ECECECEC'; //Valid hex notation
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := '-0x9CAB0000EABFDCBA'; //"Negative" hex number
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := ' 0X75d300002F4aB9c1A'; //Two /2) leading blanks and upper case X in hex prefix
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToInt64Ex(PChar(numstr), flags, @number);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
numstr := ' +12955376'; //Leading space, plus sign, and invalid pointer to Int64 variable
flags := STIF_DEFAULT; //(= STIF_DEFAULT = $00000000;);
apiretval := StrToInt64Ex(PChar(numstr), flags, NIL);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
//Wide character/Unicode version
wcharnumstr := '$F4d7'; //Pascal hex prefix and invalid pointer to Int64 variable
numstr := wcharnumstr;
flags := 1; //(= STIF_SUPPORT_HEX = $00000001;);
apiretval := StrToInt64ExW(PWChar(wcharnumstr), flags, NIL);
newinfoline := 'StrToInt64Ex called with "' + numstr + '" returned : ';
IF apiretval = TRUE THEN
newinfoline := newinfoline + 'TRUE, '
ELSE
newinfoline := newinfoline + 'FALSE, ';
newinfoline := newinfoline + IntToStr(number) + ' (0x' + IntToHex(number, 16) + ')';
Memo1.Lines.Add(newinfoline);
number := 0;
apiretval := FALSE;
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPISHCreateShellPalette(Sender : TObject);
//VAR devcontext : HDC;
//VAR devcaps : INTEGER;
//VAR palhandle : HPALETTE;
//VAR numpalcolors : INTEGER;
//VAR palbmp : TBitmap;
VAR newinfoline : STRING;
BEGIN
newinfoline := '';
newinfoline := 'Function call not implemented yet !';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPISHFormatDateTime(Sender : TObject);
//Important ! Without the FDTF_NOAUTOREADINGORDER flag,
//SHFormatDateTime inserts question marks before all parts of
//the string.
VAR currentdatetime : TFileTime;
VAR datetimestrbuf : ARRAY [0 .. 128] OF CHAR;
VAR datetimewcharbuf : ARRAY [0 .. 128] OF WideChar;
VAR fmtflags : DWORD;
VAR bufsize : UINT;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
FillChar(currentdatetime, SizeOf(currentdatetime), #0);
FillChar(datetimestrbuf, Length(datetimestrbuf), #0);
FillChar(datetimewcharbuf, Length(datetimewcharbuf), #0);
fmtflags := 0;
bufsize := 0;
apiretval := 0;
newinfoline := '';
GetSystemTimeAsFileTime(currentdatetime);
fmtflags := FDTF_LONGDATE OR FDTF_LONGTIME; // OR FDTF_NOAUTOREADINGORDER; // OR FDTF_RELATIVE;
bufsize := Length(datetimestrbuf);
newinfoline := 'SHFormatDateTime called with current date and time : ';
Memo1.Lines.Add(newinfoline);
apiretval := SHFormatDateTime(@currentdatetime, @fmtflags, datetimestrbuf, bufsize);
newinfoline := IntToStr(apiretval) + ', ';
newinfoline := newinfoline + datetimestrbuf;
Memo1.Lines.Add(newinfoline);
fmtflags := FDTF_LONGDATE OR FDTF_LONGTIME OR FDTF_RELATIVE OR FDTF_NOAUTOREADINGORDER;
bufsize := Length(datetimewcharbuf);
apiretval := SHFormatDateTimeW(@currentdatetime, @fmtflags, datetimewcharbuf, bufsize);
newinfoline := datetimewcharbuf;
newinfoline := IntToStr(apiretval) + ', ' + newinfoline;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrFromTimeInterval(Sender : TObject);
VAR millisecs : DWORD;
VAR timespanstrbufp : PChar;
VAR bufsize : UINT;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
millisecs := 0;
timespanstrbufp := NIL;
apiretval := 0;
newinfoline := '';
millisecs := GetTickCount();
//Retrieve the required buffer size
bufsize := UINT(StrFromTimeInterval(NIL, 0, millisecs, 1));
timespanstrbufp := StrAlloc(bufsize + 1);
newinfoline := 'StrFromTimeInterval called with ' + IntToStr(millisecs);
Memo1.Lines.Add(newinfoline);
apiretval := StrFromTimeInterval(timespanstrbufp, bufsize, millisecs, 1);
newinfoline := timespanstrbufp;
newinfoline := IntToStr(apiretval) + ', ' + newinfoline;
Memo1.Lines.Add(newinfoline);
StrDispose(timespanstrbufp);
timespanstrbufp := NIL;
//Retrieve the required buffer size
bufsize := UINT(StrFromTimeInterval(NIL, 0, millisecs, 4));
timespanstrbufp := StrAlloc(bufsize + 1);
newinfoline := 'StrFromTimeInterval called with ' + IntToStr(millisecs);
Memo1.Lines.Add(newinfoline);
apiretval := StrFromTimeInterval(timespanstrbufp, bufsize, millisecs, 4);
newinfoline := timespanstrbufp;
newinfoline := IntToStr(apiretval) + ', ' + newinfoline;
Memo1.Lines.Add(newinfoline);
StrDispose(timespanstrbufp);
bufsize := UINT(StrFromTimeInterval(NIL, 0, millisecs, 8));
timespanstrbufp := StrAlloc(bufsize + 1);
newinfoline := 'StrFromTimeInterval called with ' + IntToStr(millisecs);
Memo1.Lines.Add(newinfoline);
apiretval := StrFromTimeInterval(timespanstrbufp, bufsize, millisecs, 8);
newinfoline := timespanstrbufp;
newinfoline := IntToStr(apiretval) + ', ' + newinfoline;
Memo1.Lines.Add(newinfoline);
StrDispose(timespanstrbufp);
millisecs := GetTickCount();
bufsize := UINT(StrFromTimeInterval(NIL, 0, millisecs, 8));
//Create buffer that makes allowances for the leading blank (i.e. a much too large buffer)
bufsize := bufsize + 9;
timespanstrbufp := StrAlloc(bufsize);
ZeroMemory(timespanstrbufp, bufsize);
newinfoline := 'StrFromTimeInterval called with ' + IntToStr(millisecs);
Memo1.Lines.Add(newinfoline);
apiretval := StrFromTimeInterval(timespanstrbufp, bufsize, millisecs, 8);
newinfoline := timespanstrbufp;
newinfoline := IntToStr(apiretval) + ', ' + newinfoline;
Memo1.Lines.Add(newinfoline);
StrDispose(timespanstrbufp);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrFormatKBSize(Sender : TObject);
VAR filehandle : HFILE;
VAR sizetoconvert : LARGE_INTEGER;
VAR disksize : LARGE_INTEGER;
VAR totalnumfree : LARGE_INTEGER;
VAR sizestrbuf : ARRAY[0 .. 127] OF CHAR;
VAR bufsize : UINT;
VAR apiretpointer : PChar;
VAR newinfoline : STRING;
BEGIN
filehandle := 0;
FillChar(sizetoconvert, SizeOf(sizetoconvert), #0);
FillChar(disksize, SizeOf(disksize), #0);
FillChar(totalnumfree, SizeOf(totalnumfree), #0);
FillChar(sizestrbuf, Length(sizestrbuf), #0);
bufsize := 0;
apiretpointer := NIL;
newinfoline := '';
filehandle := CreateFile('C:\Windows\System32\ShlWAPI.dll', GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, NIL,
OPEN_EXISTING, 0, 0);
sizetoconvert.LowPart := GetFileSize(filehandle, @sizetoconvert.HighPart);
newinfoline := 'StrFormatKBSize called with ' + IntToStr(Int64(sizetoconvert));
Memo1.Lines.Add(newinfoline);
bufsize := Length(sizestrbuf);
apiretpointer := StrFormatKBSize(LONGLONG(sizetoconvert), sizestrbuf, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
CloseHandle(filehandle);
GetDiskFreeSpaceEx('C:\', Int64(sizetoconvert), Int64(disksize), @totalnumfree);
newinfoline := 'StrFormatKBSize called with ' + IntToStr(Int64(sizetoconvert));
Memo1.Lines.Add(newinfoline);
bufsize := Length(sizestrbuf);
apiretpointer := StrFormatKBSize(LONGLONG(sizetoconvert), sizestrbuf, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrFormatByteSizeA(Sender : TObject);
VAR filehandle : HFILE;
VAR sizetoconvert : DWORD;
VAR sizestrbuf : ARRAY[0 .. 127] OF CHAR;
VAR bufsize : UINT;
VAR apiretpointer : PChar;
VAR newinfoline : STRING;
BEGIN
filehandle := 0;
sizetoconvert := 0;
bufsize := 0;
apiretpointer := NIL;
newinfoline := '';
filehandle := CreateFile('C:\Windows\explorer.exe', GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, NIL,
OPEN_EXISTING, 0, 0);
sizetoconvert := GetFileSize(filehandle, NIL);
newinfoline := 'StrFormatByteSizeA called with ' + IntToStr(sizetoconvert);
Memo1.Lines.Add(newinfoline);
bufsize := Length(sizestrbuf);
apiretpointer := StrFormatByteSize(sizetoconvert, sizestrbuf, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
CloseHandle(filehandle);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrFormatByteSizeW(Sender : TObject);
VAR filehandle : HFILE;
VAR sizetoconvert : LARGE_INTEGER;
VAR disksize : LARGE_INTEGER;
VAR totalnumfree : LARGE_INTEGER;
VAR sizestrbuf : ARRAY[0 .. 127] OF WideChar;
VAR bufsize : UINT;
VAR apiretpointer : PWideChar;
VAR newinfoline : STRING;
BEGIN
filehandle := 0;
FillChar(sizetoconvert, SizeOf(sizetoconvert), #0);
FillChar(disksize, SizeOf(disksize), #0);
FillChar(totalnumfree, SizeOf(totalnumfree), #0);
FillChar(sizestrbuf, SizeOf(sizestrbuf), #0);
bufsize := 0;
apiretpointer := NIL;
newinfoline := '';
filehandle := CreateFile('C:\Windows\System32\ShlWAPI.dll', GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, NIL,
OPEN_EXISTING, 0, 0);
sizetoconvert.LowPart := GetFileSize(filehandle, @sizetoconvert.HighPart);
newinfoline := 'StrFormatByteSizeW called with ' + IntToStr(Int64(sizetoconvert));
Memo1.Lines.Add(newinfoline);
bufsize := Length(sizestrbuf);
apiretpointer := StrFormatByteSizeW(LONGLONG(sizetoconvert), sizestrbuf, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
CloseHandle(filehandle);
GetDiskFreeSpaceEx('C:\', Int64(sizetoconvert), Int64(disksize), @totalnumfree);
newinfoline := 'StrFormatByteSizeW called with ' + IntToStr(Int64(sizetoconvert));
Memo1.Lines.Add(newinfoline);
bufsize := Length(sizestrbuf);
apiretpointer := StrFormatByteSizeW(LONGLONG(sizetoconvert), sizestrbuf, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrFormatByteSize64A(Sender : TObject);
VAR filehandle : HFILE;
VAR sizetoformat : LARGE_INTEGER;
VAR totalbytes : LONGLONG;
VAR bytesavailable : LONGLONG;
VAR sizestrbufp : PChar;
//VAR wcharstrbuf : ARRAY[0..64] OF WideChar;
VAR bufsize : UINT;
VAR apiretpointer : PChar;
//VAR apiwcharretptr : PWideChar;
VAR newinfoline : STRING;
BEGIN
filehandle := 0;
FillChar(sizetoformat, SizeOf(sizetoformat), #0);
FillChar(totalbytes, SizeOf(totalbytes), #0);
FillChar(bytesavailable, SizeOf(bytesavailable), #0);
sizestrbufp := NIL;
//FillChar(wcharstrbuf, SizeOf(wcharstrbuf), #0);
bufsize := 0;
apiretpointer := NIL;
//apiwcharretptr := NIL;
newinfoline := '';
//Format as byte
newinfoline := 'StrFormatByteSize64A called with ' + IntToStr(Int64(sizetoformat));
Memo1.Lines.Add(newinfoline);
sizestrbufp := StrAlloc(64);
bufsize := StrBufSize(sizestrbufp);
apiretpointer := StrFormatByteSize64A(LONGLONG(sizetoformat), sizestrbufp, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
StrDispose(sizestrbufp);
//Format as KByte
sizetoformat.LowPart := 12345;
newinfoline := 'StrFormatByteSize64A called with ' + IntToStr(Int64(sizetoformat));
Memo1.Lines.Add(newinfoline);
sizestrbufp := StrAlloc(64);
bufsize := StrBufSize(sizestrbufp);
apiretpointer := StrFormatByteSize64A(LONGLONG(sizetoformat), sizestrbufp, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
StrDispose(sizestrbufp);
//Format as MByte
filehandle := CreateFile('C:\Windows\System32\Shell32.dll', GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, NIL,
OPEN_EXISTING, 0, 0);
sizetoformat.LowPart := GetFileSize(filehandle, @sizetoformat.HighPart);
newinfoline := 'StrFormatByteSize64A called with ' + IntToStr(Int64(sizetoformat));
Memo1.Lines.Add(newinfoline);
sizestrbufp := StrAlloc(64);
bufsize := StrBufSize(sizestrbufp);
apiretpointer := StrFormatByteSize64A(LONGLONG(sizetoformat), sizestrbufp, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
StrDispose(sizestrbufp);
CloseHandle(filehandle);
//Test Unicode version
//newinfoline := 'StrFormatByteSize64A called with Unicode buffer and ' + IntToStr(Int64(sizetoformat));
//bufsize := 64; //See declaration
//apiwcharretptr := StrFormatByteSize64A(LONGLONG(sizetoformat), PChar(@wcharstrbuf), bufsize);
//Format as GByte
FillChar(sizetoformat, SizeOf(sizetoformat), #0);
GetDiskFreeSpaceEx('E:\', TLargeInteger(sizetoformat), totalbytes, @bytesavailable);
newinfoline := 'StrFormatByteSize64A called with ' + IntToStr(Int64(sizetoformat));
Memo1.Lines.Add(newinfoline);
sizestrbufp := StrAlloc(64);
bufsize := StrBufSize(sizestrbufp);
apiretpointer := StrFormatByteSize64A(LONGLONG(sizetoformat), sizestrbufp, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
newinfoline := '';
newinfoline := 'StrFormatByteSize64A called with ' + IntToStr(Int64(totalbytes));
Memo1.Lines.Add(newinfoline);
apiretpointer := StrFormatByteSize64A(totalbytes, sizestrbufp, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
newinfoline := '';
newinfoline := '';
newinfoline := 'StrFormatByteSize64A called with ' + IntToStr(Int64(bytesavailable));
Memo1.Lines.Add(newinfoline);
apiretpointer := StrFormatByteSize64A(bytesavailable, sizestrbufp, bufsize);
newinfoline := apiretpointer;
Memo1.Lines.Add(newinfoline);
StrDispose(sizestrbufp);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrFormatByteSizeEx(Sender : TObject);
VAR filehandle : HFILE;
VAR sizetofmt : ULARGE_INTEGER;
VAR fmtflags : SFBS_FLAGS;
VAR sizestrbuf : ARRAY[0 .. 127] OF WideChar;
VAR bufsize : UINT;
VAR apiretval : HRESULT;
VAR newinfoline : STRING;
BEGIN
filehandle := 0;
FillChar(sizetofmt, SizeOf(sizetofmt), #0);
fmtflags := 0;
FillChar(sizestrbuf, SizeOf(sizestrbuf), #0);
bufsize := 0;
apiretval := S_OK; //S_OK = 0
newinfoline := '';
filehandle := CreateFile('C:\Windows\System32\comctl32.dll', GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, NIL,
OPEN_EXISTING, 0, 0);
sizetofmt.LowPart := GetFileSize(filehandle, @sizetofmt.HighPart);
newinfoline := 'StrFormatByteSizeEx called with ' + IntToStr(Int64(sizetofmt));
Memo1.Lines.Add(newinfoline);
bufsize := Length(sizestrbuf);
fmtflags := SFBS_FLAGS_ROUND_TO_NEAREST_DISPLAYED_DIGIT;
apiretval := StrFormatByteSizeEx(sizetofmt, fmtflags, sizestrbuf, bufsize);
newinfoline := sizestrbuf;
Memo1.Lines.Add(newinfoline);
FillChar(sizestrbuf, SizeOf(sizestrbuf), #0);
fmtflags := SFBS_FLAGS_TRUNCATE_UNDISPLAYED_DECIMAL_DIGITS;
apiretval := StrFormatByteSizeEx(sizetofmt, fmtflags, sizestrbuf, bufsize);
newinfoline := sizestrbuf;
Memo1.Lines.Add(newinfoline);
CloseHandle(filehandle);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrCSpn(Sender : TObject);
//Compare result to that of "StrSpn", below
VAR txttosearch : STRING;
VAR txttosrchlen : INTEGER;
VAR charsettosrch : STRING;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
txttosearch := '';
txttosrchlen := 0;
charsettosrch := '';
apiretval := 0;
newinfoline := '';
txttosearch := 'This function''s functionality is somewhat easier to understand.';
txttosrchlen := Length(txttosearch);
charsettosrch := 'w';
newinfoline := 'StrCSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrCSpn(PChar(txttosearch), PChar(charsettosrch));
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrCSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrCSpn did not find any of the listed characters.';
Memo1.Lines.Add(newinfoline);
txttosearch := 'This function''s functionality is somewhat easier to understand.';
charsettosrch := 'wm';
newinfoline := 'StrCSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrCSpn(PChar(txttosearch), PChar(charsettosrch));
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrCSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrCSpn did not find any of the listed characters.';
Memo1.Lines.Add(newinfoline);
txttosearch := 'This function''s functionality is somewhat easier to understand.';
charsettosrch := 'wme';
newinfoline := 'StrCSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrCSpn(PChar(txttosearch), PChar(charsettosrch));
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrCSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrCSpn did not find any of the listed characters.';
Memo1.Lines.Add(newinfoline);
txttosearch := 'This function''s functionality is somewhat easier to understand.';
charsettosrch := 'wmf';
newinfoline := 'StrCSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrCSpn(PChar(txttosearch), PChar(charsettosrch));
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrCSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrCSpn did not find any of the listed characters.';
Memo1.Lines.Add(newinfoline);
txttosearch := 'This function''s functionality is somewhat easier to understand.';
charsettosrch := 'FW';
newinfoline := 'StrCSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrCSpn(PChar(txttosearch), PChar(charsettosrch));
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrCSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrCSpn did not find any of the listed characters.';
Memo1.Lines.Add(newinfoline);
txttosearch := 'This function''s functionality is somewhat easier to understand.';
charsettosrch := 'F W'; //Note the blank between F and W !
newinfoline := 'StrCSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrCSpn(PChar(txttosearch), PChar(charsettosrch));
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrCSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrCSpn did not find any of the listed characters.';
Memo1.Lines.Add(newinfoline);
txttosearch := 'This function''s functionality is ' + #13 + #10 + 'somewhat easier to understand.';
charsettosrch := 'F' + #13 + 'W'; //Note the carriage return between F and W !
newinfoline := 'StrCSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrCSpn(PChar(txttosearch), PChar(charsettosrch));
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrCSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrCSpn did not find any of the listed characters.';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIStrSpn(Sender : TObject);
//Compare result to that of "StrCSpn", above
VAR txttosearch : STRING;
VAR txttosrchlen : INTEGER;
VAR charsettosrch : STRING;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
txttosearch := '';
txttosrchlen := 0;
charsettosrch := '';
apiretval := 0;
newinfoline := '';
txttosearch := 'AaAAbBBBCCCcDDdD'; //This string consists of the characters a, A, b, B, c, C, d, and D
charsettosrch := 'AbBcCdD'; // <- Note that we've listed all characters except for the lower case "a"
newinfoline := 'StrSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrSpn(PChar(txttosearch), PChar(charsettosrch));
newinfoline := 'StrSpn returned ' + IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
txttosearch := 'AaAAbBBBCCCcDDdD'; //This string consists of the characters a, A, b, B, c, C, d, and D
charsettosrch := 'AabBcdD'; // <- Note that we've listed all characters except for the upper case "C"
newinfoline := 'StrSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrSpn(PChar(txttosearch), PChar(charsettosrch));
newinfoline := 'StrSpn returned ' + IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
txttosearch := 'It is not entirely clear what this function does.';
charsettosrch := 'cdefh Iiost'; //Note, that this string includes a blank, but not a lower case "n"
newinfoline := 'StrSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrSpn(PChar(txttosearch), PChar(charsettosrch));
newinfoline := 'StrSpn returned ' + IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
txttosearch := 'It is not entirely clear what this function does.';
txttosrchlen := Length(txttosearch);
charsettosrch := 'acdefhI. ilnorstuwy'; //Here we've listed all characters that occur in the sentence we're searching
newinfoline := 'StrSpn called with "' + txttosearch + '" and "' + charsettosrch + '"';
Memo1.Lines.Add(newinfoline);
apiretval := StrSpn(PChar(txttosearch), PChar(charsettosrch));
newinfoline := 'StrSpn returned ' + IntToStr(apiretval);
IF apiretval <> txttosrchlen THEN
newinfoline := 'StrSpn returned ' + IntToStr(apiretval)
ELSE
newinfoline := 'StrSpn did not find any characters in txttosearch that were not listed in variable charsettosrch.';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathAddExtension(Sender : TObject);
VAR pathstrbuf : ARRAY[0.. MAX_PATH] OF CHAR;
VAR extension : STRING;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
FillChar(pathstrbuf, Length(pathstrbuf), #0);
extension := '';
apiretval := FALSE;
newinfoline := '';
pathstrbuf := 'C:\Hello\World';
extension := '.txt';
newinfoline := pathstrbuf;
newinfoline := 'PathAddExtension called with ' + newinfoline + ' and ' + extension;
Memo1.Lines.Add(newinfoline);
apiretval := PathAddExtension(pathstrbuf, PChar(extension));
IF apiretval THEN
newinfoline := 'TRUE ' + pathstrbuf
ELSE
newinfoline := 'FALSE' + pathstrbuf;
Memo1.Lines.Add(newinfoline);
apiretval := FALSE;
pathstrbuf := 'C:\Hello\World\';
extension := '.txt';
newinfoline := pathstrbuf;
newinfoline := 'PathAddExtension called with ' + newinfoline + ' and ' + extension;
Memo1.Lines.Add(newinfoline);
apiretval := PathAddExtension(pathstrbuf, PChar(extension));
newinfoline := pathstrbuf;
IF apiretval THEN
newinfoline := 'TRUE ' + pathstrbuf
ELSE
newinfoline := 'FALSE' + pathstrbuf;
Memo1.Lines.Add(newinfoline);
apiretval := FALSE;
pathstrbuf := 'C:\Hello\World\DummyName.csv';
extension := '.txt';
newinfoline := pathstrbuf;
newinfoline := 'PathAddExtension called with ' + newinfoline + ' and ' + extension;
Memo1.Lines.Add(newinfoline);
apiretval := PathAddExtension(pathstrbuf, PChar(extension));
newinfoline := pathstrbuf;
IF apiretval THEN
newinfoline := 'TRUE ' + pathstrbuf
ELSE
newinfoline := 'FALSE' + pathstrbuf;
Memo1.Lines.Add(newinfoline);
apiretval := FALSE;
pathstrbuf := 'C:\Hello\World\DummyName';
extension := '';
newinfoline := pathstrbuf;
newinfoline := 'PathAddExtension called with ' + newinfoline + ' and an empty string';
Memo1.Lines.Add(newinfoline);
apiretval := PathAddExtension(pathstrbuf, PChar(extension));
newinfoline := pathstrbuf;
IF apiretval THEN
newinfoline := 'TRUE ' + pathstrbuf
ELSE
newinfoline := 'FALSE' + pathstrbuf;
Memo1.Lines.Add(newinfoline);
apiretval := FALSE;
pathstrbuf := 'C:\Hello\World\DummyName';
extension := '';
newinfoline := pathstrbuf;
newinfoline := 'PathAddExtension called with ' + newinfoline + ' and NIL';
Memo1.Lines.Add(newinfoline);
apiretval := PathAddExtension(pathstrbuf, NIL);
newinfoline := pathstrbuf;
IF apiretval THEN
newinfoline := 'TRUE ' + pathstrbuf
ELSE
newinfoline := 'FALSE' + pathstrbuf;
Memo1.Lines.Add(newinfoline);
apiretval := FALSE;
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathCombine(Sender : TObject);
VAR dirpartstr : STRING;
VAR filepartstr : STRING;
VAR pathstrbuf : ARRAY[0.. MAX_PATH] OF CHAR;
VAR apiretval : PChar;
VAR newinfoline : STRING;
BEGIN
dirpartstr := '';
filepartstr := '';
FillChar(pathstrbuf, Length(pathstrbuf), #0);
apiretval := NIL;
newinfoline := '';
pathstrbuf := 'D:\InitialContents';
dirpartstr := 'C:\Hello\World\';
filepartstr := 'DummyFileName.txt';
newinfoline := 'PathCombine called with ' + dirpartstr + ' and ' + filepartstr;
Memo1.Lines.Add(newinfoline);
apiretval := PathCombine(pathstrbuf, PChar(dirpartstr), PChar(filepartstr));
//dirpartstr := '';
filepartstr := 'DummyFileName';
apiretval := PathCombine(pathstrbuf, PChar(dirpartstr), PChar(filepartstr));
//apiretval := PathCombine(pathstrbuf, NIL, PChar(filepartstr));
newinfoline := pathstrbuf;
Memo1.Lines.Add(newinfoline);
dirpartstr := '..\Hello\World\';
filepartstr := '..\SubDir\DummyFileName.txt';
newinfoline := 'PathCombine called with ' + dirpartstr + ' and ' + filepartstr;
Memo1.Lines.Add(newinfoline);
apiretval := PathCombine(pathstrbuf, PChar(dirpartstr), PChar(filepartstr));
newinfoline := pathstrbuf;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathCreateFromUrl(Sender : TObject);
VAR urltoconvert : STRING;
VAR pathstrbuf : ARRAY[0.. MAX_PATH] OF CHAR;
VAR pathstrlen : DWORD;
VAR apiretval : HRESULT;
VAR newinfoline : STRING;
BEGIN
urltoconvert := '';
FillChar(pathstrbuf, Length(pathstrbuf), #0);
pathstrlen := 0;
apiretval := 0; //= S_OK
newinfoline := '';
//pathstrlen := INTERNET_MAX_URL_LENGTH; //for development and debugging only !!!
//The following line returns the DOS path part
urltoconvert := 'file:///S:/Projects/SST/SSTWebsite/Develop2016/en/contact/Email.htm';
pathstrlen := Length(pathstrbuf) - 1;
newinfoline := 'PathCreateFromUrl called with ' + urltoconvert;
Memo1.Lines.Add(newinfoline);
//apiretval := PathCreateFromUrl(PChar(urltoconvert), pathstrbuf, @pathstrlen, 0);
apiretval := PathCreateFromUrl(PChar(urltoconvert), @pathstrbuf[0], @pathstrlen, 0);
//apiretval := PathCreateFromUrl(PChar(urltoconvert), @pathstrbuf[0], @pathstrlen, 1); //Doesn't cause an error but seems to have no effect !!!
IF apiretval = S_OK THEN
newinfoline := pathstrbuf
ELSE
newinfoline := 'returned error code : ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
//The following line fails
urltoconvert := 'http://127.0.0.1/Develop2016/en/products/development%20libraries/delphi/shlwapi/support/DevRef.htm';
pathstrlen := Length(pathstrbuf) - 1;
newinfoline := 'PathCreateFromUrl called with ' + urltoconvert;
Memo1.Lines.Add(newinfoline);
apiretval := PathCreateFromUrl(PChar(urltoconvert), @pathstrbuf[0], @pathstrlen, 0);
//apiretval := PathCreateFromUrl(PChar(urltoconvert), @pathstrbuf[0], @pathstrlen, 1); //Doesn't cause an error but seems to have no effect !!!
IF apiretval = S_OK THEN
newinfoline := pathstrbuf
ELSE
newinfoline := 'returned error code : ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathFileExists(Sender : TObject);
VAR nametovrify : STRING;
VAR apiretval : BOOL;
VAR exterrorcode : INTEGER;
VAR newinfoline : STRING;
BEGIN
nametovrify := '';
apiretval := FALSE;
exterrorcode := 0;
newinfoline := '';
nametovrify := 'C:\Windows\System32\Shell32.dll';
newinfoline := 'PathFileExists called with ' + nametovrify;
Memo1.Lines.Add(newinfoline);
apiretval := PathFileExists(PChar(nametovrify));
IF apiretval THEN
newinfoline := 'returned TRUE'
ELSE
newinfoline := 'returned FALSE';
Memo1.Lines.Add(newinfoline);
nametovrify := 'C:\Windows\System32\DummyFolderName.xls';
newinfoline := 'PathFileExists called with ' + nametovrify;
Memo1.Lines.Add(newinfoline);
apiretval := PathFileExists(PChar(nametovrify));
IF apiretval THEN
newinfoline := 'returned TRUE'
ELSE
BEGIN
newinfoline := 'returned FALSE';
exterrorcode := INTEGER(GetLastError());
newinfoline := newinfoline + ' GetLastError provided the additional error info : ' + IntToStr(exterrorcode);
END;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathFindSuffixArray(Sender : TObject);
VAR pathandname : STRING; //Contains the file name of which to determine the suffix/extension
VAR extensionarr : ARRAY[0..7] OF STRING;
VAR extensionarrp : PChar; //Array consisting of the suffixes/extensions to test the name for
VAR retsuffixp : PChar;
VAR numsuffixes : INTEGER;
VAR newinfoline : STRING;
BEGIN
pathandname := '';
//extensionarr := '';
extensionarrp := NIL;
retsuffixp := NIL;
numsuffixes := 0;
newinfoline := '';
pathandname := 'C:\Windows\Explorer.exe';
extensionarr[0] := 'dll';
extensionarr[1] := 'Exe';
extensionarr[2] := '.exe';
extensionarrp := @extensionarr[0];
numsuffixes := 3;
newinfoline := 'PathFindSuffixArray called with : "' + pathandname + '" returned ';
Memo1.Lines.Add(newinfoline);
retsuffixp := PathFindSuffixArray(PChar(pathandname), extensionarrp, numsuffixes);
newinfoline := retsuffixp;
Memo1.Lines.Add(newinfoline);
pathandname := 'regedit.exe';
extensionarr[0] := 'dll';
extensionarr[1] := '.Exe';
extensionarr[2] := 'exe';
extensionarrp := @extensionarr[0];
numsuffixes := 3;
newinfoline := 'PathFindSuffixArray called with : "' + pathandname + '" returned ';
Memo1.Lines.Add(newinfoline);
retsuffixp := PathFindSuffixArray(PChar(pathandname), extensionarrp, numsuffixes);
newinfoline := retsuffixp;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathGetArgs(Sender : TObject);
VAR democmdline : STRING;
VAR cmdlineargsp : PChar;
VAR newinfoline : STRING;
BEGIN
democmdline := '';
cmdlineargsp := NIL;
newinfoline := '';
//Fabricate a command line with fictious command line parameters
democmdline := ParamStr(0) + ' -Arg1 /Arg2';
cmdlineargsp := PathGetArgs(PChar(democmdline));
newinfoline := 'PathGetArgs called with command line : "' + democmdline + '" returned ';
Memo1.Lines.Add(newinfoline);
newinfoline := cmdlineargsp;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathFindNextComponent(Sender : TObject);
VAR pathcomponents : STRING;
VAR nextcomponentp : PChar;
VAR newinfoline : STRING;
BEGIN
pathcomponents := '';
nextcomponentp := NIL;
newinfoline := '';
pathcomponents := 'C:\Hello\Windows\World';
newinfoline := 'PathFindNextComponent called with ' + pathcomponents;
Memo1.Lines.Add(newinfoline);
nextcomponentp := PathFindNextComponent(PChar(pathcomponents));
newinfoline := nextcomponentp;
Memo1.Lines.Add(newinfoline);
pathcomponents := nextcomponentp;
newinfoline := 'PathFindNextComponent called with ' + pathcomponents;
Memo1.Lines.Add(newinfoline);
nextcomponentp := PathFindNextComponent(PChar(pathcomponents));
newinfoline := nextcomponentp;
Memo1.Lines.Add(newinfoline);
pathcomponents := 'Hello/Unix/World';
nextcomponentp := NIL;
newinfoline := 'PathFindNextComponent called with ' + pathcomponents;
Memo1.Lines.Add(newinfoline);
nextcomponentp := PathFindNextComponent(PChar(pathcomponents));
IF ((nextcomponentp <> NIL) AND (nextcomponentp^ <> #0)) THEN
newinfoline := nextcomponentp
ELSE
newinfoline := 'NIL';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathGetDriveNumber(Sender : TObject);
VAR srcpath : STRING;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
srcpath := '';
apiretval := 0;
newinfoline := '';
srcpath := 'C:\Windows';
apiretval := PathGetDriveNumber(PChar(srcpath));
newinfoline := 'PathGetDriveNumber called with parameter ' + srcpath +
' returned : ' + IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
newinfoline := '';
srcpath := 'X:\NonExistentDir\NonExistentSubDir';
apiretval := PathGetDriveNumber(PChar(srcpath));
newinfoline := 'PathGetDriveNumber called with parameter ' + srcpath +
' returned : ' + IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
srcpath := '..\..\..\NonExistentDir\NonExistentSubDir';
apiretval := PathGetDriveNumber(PChar(srcpath));
newinfoline := 'PathGetDriveNumber called with parameter ' + srcpath +
' returned : ' + IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
srcpath := '..\NonExistentDir\NonExistentSubDir';
apiretval := PathGetDriveNumber(PChar(srcpath));
newinfoline := 'PathGetDriveNumber called with parameter ' + srcpath +
' returned : ' + IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathFindOnPath(Sender : TObject);
VAR filetofindbuf : ARRAY[0 .. MAX_PATH] OF CHAR;
VAR otherdirs : STRING;
//VAR otherdirsarray : ARRAY[0 .. 2] OF PChar;
VAR otherdirsarray : ARRAY[0 .. 1] OF PChar;
VAR otherdirsarrayp : POINTER;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
FillChar(filetofindbuf, Length(filetofindbuf), #0);
otherdirs := '';
otherdirsarray[0] := NIL;
otherdirsarray[1] := NIL;
//otherdirsarray[2] := NIL;
otherdirsarrayp := NIL;
apiretval := FALSE;
newinfoline := '';
filetofindbuf := 'Notepad.exe';
otherdirs := '';
newinfoline := filetofindbuf;
newinfoline := 'PathFindOnPath called with ' + filetofindbuf;
Memo1.Lines.Add(newinfoline);
//apiretval := PathFindOnPath(filetofindbuf, PChar(otherdirs));
apiretval := PathFindOnPath(filetofindbuf, NIL);
IF apiretval THEN
newinfoline := 'TRUE ' + filetofindbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
filetofindbuf := 'Orca.exe';
//otherdirs := 'C:\Program Files\Common Files;C:\Program Files\Orca';
otherdirsarray[0] := 'C:\Program Files\Common Files';
otherdirsarray[1] := 'C:\Program Files\Orca';
//otherdirsarray[2] := NIL;
otherdirsarrayp := @otherdirsarray;
newinfoline := filetofindbuf;
newinfoline := 'PathFindOnPath called with ' + filetofindbuf;
newinfoline := newinfoline + ' ' + otherdirsarray[0];
newinfoline := newinfoline + ' ' + otherdirsarray[1];
Memo1.Lines.Add(newinfoline);
apiretval := PathFindOnPath(filetofindbuf, PChar(otherdirsarrayp));
IF apiretval THEN
newinfoline := 'TRUE ' + filetofindbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathPathIsDirectory(Sender : TObject);
VAR pathtotest : STRING;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
pathtotest := '';
apiretval := FALSE;
newinfoline := '';
pathtotest := 'C:\Windows\System32';
newinfoline := 'PathIsDirectory called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsDirectory(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:/Program Files/Internet Explorer/en-US';
newinfoline := 'PathIsDirectory called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsDirectory(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Windows\System32\Shell32.dll';
newinfoline := 'PathIsDirectory called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsDirectory(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Windows\System32\Hello\World';
newinfoline := 'PathIsDirectory called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsDirectory(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathIsLFNFileSpec(Sender : TObject);
VAR pathtotest : STRING;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
pathtotest := '';
apiretval := FALSE;
newinfoline := '';
//Could be either; a DOS or LFN path (and file name)
pathtotest := 'C:\Windows\System32\Kernel32.dll';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//LFN path
pathtotest := 'C:\Program Files\Common Files';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//DOS path
pathtotest := 'C:\PROGRA~1\COMMON~1';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//LFN path and file name
pathtotest := 'C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Paint.lnk';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//DOS path and file name
pathtotest := 'C:\PROGRA~2\MICROS~1\Windows\STARTM~1\Programs\Paint.lnk';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//Relative DOS path
pathtotest := '..\PROGRA~2\MICROS~1';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'PROGRA~2';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'ProgramData';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'DOS?Name'; //Invalid DOS name, no suffix
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'DOSName.LFNExt'; //Valid DOS name, invalid, DOS suffix, overall length > 8 + 3
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'DOS.Suffx'; //Valid DOS name, invalid DOS suffix, overall length <= 8 + 3
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'DOSName.Ext'; //Valid DOS name and suffix
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'InvalidLFNFileName_>';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'ValidLFNFileNamePlusShortExt.txt';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'ValidLFNFileNamePlus.Extension';
newinfoline := 'PathIsLFNFileSpec called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsLFNFileSpec(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathIsRoot(Sender : TObject);
VAR pathtotest : STRING;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
pathtotest := '';
apiretval := FALSE;
newinfoline := '';
pathtotest := 'C:\Hello\Windows\World';
newinfoline := 'PathIsRoot called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsRoot(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'X:\';
newinfoline := 'PathIsRoot called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsRoot(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '\\FILESERVER1\Public';
newinfoline := 'PathIsRoot called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsRoot(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathIsUNC(Sender : TObject);
VAR pathtotest : STRING;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
pathtotest := '';
apiretval := FALSE;
newinfoline := '';
pathtotest := 'C:\Windows\System32';
newinfoline := 'PathIsUNC called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsUNC(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '\\WORKSTATION1\Public';
newinfoline := 'PathIsUNC called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsUNC(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '\\WEBSERVER1\I\Website\DevRef.htm';
newinfoline := 'PathIsUNC called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsUNC(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'd:/topleveldir/subdir1/subdir2';
newinfoline := 'PathIsUNC called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsUNC(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '//WEBSERVER1/ShareDir/Website/DevRef.htm';
newinfoline := 'PathIsUNC called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsUNC(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '..\Windows\Temp\';
newinfoline := 'PathIsUNC called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathIsUNC(PChar(pathtotest));
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIParseURL(Sender : TObject);
//Ordinals confirmed !!!
VAR url : STRING;
VAR wcharurl : WideString;
VAR urlinfo : PARSEDURLA;
VAR wcharurlinfo : PARSEDURLW;
VAR apiretval : HRESULT;
VAR newinfoline : STRING;
BEGIN
url := '';
wcharurl := '';
FillChar(urlinfo, SizeOf(urlinfo), #0);
FillChar(wcharurlinfo, SizeOf(wcharurlinfo), #0);
apiretval := S_OK; //S_OK = 0
newinfoline := '';
url := 'http://stoelzelsoftwaretech.com/en/devlib/functions/ParseURL.htm';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'Protocol : ' + urlinfo.pszProtocol + ' (cchProtocol: ' + IntToStr(urlinfo.cchProtocol) + ' characters)';
Memo1.Lines.Add(newinfoline);
newinfoline := 'Suffix : ' + urlinfo.pszSuffix + ' (cchSuffix: ' + IntToStr(urlinfo.cchSuffix) + ' characters)';
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'http://stoelzelsoftwaretech.com/en/devlib/functions/ParseURL.htm';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
//newinfoline := Format('Protocol : %.*s (cchProtocol: %d)', [urlinfo.cchProtocol, urlinfo.pszProtocol, urlinfo.cchProtocol]);
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
//newinfoline := Format('Suffix : %.*s (cchSuffix : %d))', [urlinfo.cchSuffix, urlinfo.pszSuffix, urlinfo.cchSuffix]);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'ftp://ftp.tex.ac.uk/tex-archive/systems/unix/unixtex.ftp';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
//newinfoline := Format('Protocol : %.*s (cchProtocol: %d)', [urlinfo.cchProtocol, urlinfo.pszProtocol, urlinfo.cchProtocol]);
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
//newinfoline := Format('Suffix : %.*s (cchSuffix : %d))', [urlinfo.cchSuffix, urlinfo.pszSuffix, urlinfo.cchSuffix]);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'mailto:dummy-address@nomail.net';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
//newinfoline := Format('Protocol : %.*s (cchProtocol: %d)', [urlinfo.cchProtocol, urlinfo.pszProtocol, urlinfo.cchProtocol]);
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
//newinfoline := Format('Suffix : %.*s (cchSuffix : %d))', [urlinfo.cchSuffix, urlinfo.pszSuffix, urlinfo.cchSuffix]);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
//newinfoline := Copy(urlinfo.pszSuffix, 1, urlinfo.cchSuffix)
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'file://C:\Users\Administrator\Documents\Example.txt';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
//newinfoline := Format('Protocol : %.*s (cchProtocol: %d)', [urlinfo.cchProtocol, urlinfo.pszProtocol, urlinfo.cchProtocol]);
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
//newinfoline := Format('Suffix : %.*s (cchSuffix : %d))', [urlinfo.cchSuffix, urlinfo.pszSuffix, urlinfo.cchSuffix]);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
//Wide character/Unicode version
FillChar(wcharurlinfo, SizeOf(wcharurlinfo), #0);
apiretval := S_OK;
newinfoline := '';
wcharurl := 'https://stoelzelsoftwaretech.com/en/sitemap/TitleIndex.htm';
wcharurlinfo.cbSize := SizeOf(wcharurlinfo);
apiretval := ParseURLW(PWideChar(wcharurl), wcharurlinfo);
newinfoline := 'ParseURL called with the Unicode URL ' + AnsiQuotedStr(wcharurl, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
//newinfoline := Format('Protocol : %.*s (cchProtocol: %d)', [urlinfo.cchProtocol, urlinfo.pszProtocol, urlinfo.cchProtocol]);
newinfoline := Format('Protocol : %.*s', [wcharurlinfo.cchProtocol, wcharurlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [wcharurlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
//newinfoline := Format('Suffix : %.*s (cchSuffix : %d))', [urlinfo.cchSuffix, urlinfo.pszSuffix, urlinfo.cchSuffix]);
newinfoline := Format('Suffix : %.*s', [wcharurlinfo.cchSuffix, wcharurlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [wcharurlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(wcharurlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
//Provoke some errors
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := '';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(NIL, urlinfo); //Invalid pointer !
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'This implementation of ParseURL is capable of handling an invalid pointer to an ANSI string';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := ''; //Invalid URL string !
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'This implementation of ParseURL is capable of handling an empty URL string';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'gopher:';
//urlinfo.cbSize := SizeOf(urlinfo); //Size of record/struct NOT defined !
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'This implementation of ParseURL is capable of handling incorrectly initialized PARSEDURLA structs';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathIsSystemFolder(Sender : TObject);
VAR pathtotest : STRING;
VAR fileattributes : DWORD;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
pathtotest := '';
fileattributes := 0;
apiretval := FALSE;
newinfoline := '';
pathtotest := 'C:\Windows\System32';
fileattributes := GetFileAttributes(PChar(pathtotest));
newinfoline := 'PathIsSystemFolder called with ' + pathtotest + ' (attributes: 0x' + IntToHex(fileattributes, 8) +
') and FILE_ATTRIBUTE_SYSTEM';
Memo1.Lines.Add(newinfoline);
fileattributes := FILE_ATTRIBUTE_SYSTEM;
apiretval := PathIsSystemFolder(PChar(pathtotest), fileattributes);
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Hello\World'; //Non-existent path !
fileattributes := GetFileAttributes(PChar(pathtotest));
newinfoline := 'PathIsSystemFolder called with ' + pathtotest + ' (attributes: 0x' + IntToHex(fileattributes, 8) +
') and 0';
Memo1.Lines.Add(newinfoline);
fileattributes := 0;
apiretval := PathIsSystemFolder(PChar(pathtotest), fileattributes);
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Windows\System32\Microsoft';
fileattributes := GetFileAttributes(PChar(pathtotest));
newinfoline := 'PathIsSystemFolder called with ' + pathtotest + ' (attributes: 0x' + IntToHex(fileattributes, 8) +
') and FILE_ATTRIBUTE_SYSTEM';
Memo1.Lines.Add(newinfoline);
fileattributes := FILE_ATTRIBUTE_SYSTEM;
apiretval := PathIsSystemFolder(PChar(pathtotest), fileattributes);
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Windows\System32\Microsoft';
fileattributes := GetFileAttributes(PChar(pathtotest));
newinfoline := 'PathIsSystemFolder called with ' + pathtotest + ' (attributes: 0x' + IntToHex(fileattributes, 8) +
') and 0';
Memo1.Lines.Add(newinfoline);
fileattributes := 0;
apiretval := PathIsSystemFolder(PChar(pathtotest), fileattributes);
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Windows\System32\ShlWAPI.dll'; //Call with file instead of folder
fileattributes := GetFileAttributes(PChar(pathtotest));
newinfoline := 'PathIsSystemFolder called with ' + pathtotest + ' (attributes: 0x' + IntToHex(fileattributes, 8) +
') and FILE_ATTRIBUTE_ARCHIVE';
Memo1.Lines.Add(newinfoline);
fileattributes := FILE_ATTRIBUTE_ARCHIVE;
apiretval := PathIsSystemFolder(PChar(pathtotest), fileattributes);
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Windows\System';
fileattributes := GetFileAttributes(PChar(pathtotest));
newinfoline := 'PathIsSystemFolder called with ' + pathtotest + ' (attributes: 0x' + IntToHex(fileattributes, 8) +
') and FILE_ATTRIBUTE_READONLY';
Memo1.Lines.Add(newinfoline);
fileattributes := FILE_ATTRIBUTE_READONLY;
apiretval := PathIsSystemFolder(PChar(pathtotest), fileattributes);
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '';
newinfoline := 'PathIsSystemFolder called with an empty string ' +
' and FILE_ATTRIBUTE_SYSTEM OR FILE_ATTRIBUTE_DIRECTORY';
Memo1.Lines.Add(newinfoline);
fileattributes := FILE_ATTRIBUTE_SYSTEM OR FILE_ATTRIBUTE_DIRECTORY;
apiretval := PathIsSystemFolder(PChar(pathtotest), fileattributes);
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathSearchAndQualify(Sender : TObject);
VAR pathtotest : STRING;
VAR qualifiedpathbuf : ARRAY[0.. MAX_PATH] OF CHAR;
VAR bufsize : UINT;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
pathtotest := '';
FillChar(qualifiedpathbuf, Length(qualifiedpathbuf), #0);
bufsize := 0;
apiretval := FALSE;
newinfoline := '';
pathtotest := 'C:\Windows\System32';
bufsize := Length(qualifiedpathbuf);
newinfoline := 'PathSearchAndQualify called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathSearchAndQualify(PChar(pathtotest), qualifiedpathbuf, bufsize);
IF apiretval THEN
newinfoline := 'TRUE ' + qualifiedpathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'C:\Hello\World';
bufsize := Length(qualifiedpathbuf);
newinfoline := 'PathSearchAndQualify called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathSearchAndQualify(PChar(pathtotest), qualifiedpathbuf, bufsize);
IF apiretval THEN
newinfoline := 'TRUE ' + qualifiedpathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '\\SAMPLESERVER\DemoShare\DummyFolder\DummySubfolder';
bufsize := Length(qualifiedpathbuf);
newinfoline := 'PathSearchAndQualify called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathSearchAndQualify(PChar(pathtotest), qualifiedpathbuf, bufsize);
IF apiretval THEN
newinfoline := 'TRUE ' + qualifiedpathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := 'X:\DummyFolder\DummySubfolder\HelloWorld.c';
bufsize := Length(qualifiedpathbuf);
newinfoline := 'PathSearchAndQualify called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathSearchAndQualify(PChar(pathtotest), qualifiedpathbuf, bufsize);
IF apiretval THEN
newinfoline := 'TRUE ' + qualifiedpathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '..\DummyFolder\DummySubfolder\HelloWorld.c';
bufsize := Length(qualifiedpathbuf);
newinfoline := 'PathSearchAndQualify called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathSearchAndQualify(PChar(pathtotest), qualifiedpathbuf, bufsize);
IF apiretval THEN
newinfoline := 'TRUE ' + qualifiedpathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathtotest := '..\Y:\\DummyFolder/DummySubfolder/HelloWorld.c';
bufsize := Length(qualifiedpathbuf);
newinfoline := 'PathSearchAndQualify called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathSearchAndQualify(PChar(pathtotest), qualifiedpathbuf, bufsize);
IF apiretval THEN
newinfoline := 'TRUE ' + qualifiedpathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//BEGIN Do NOT publish !!!
pathtotest := '\\Sstxtraserver\i\Website\Graphics2015Test';
bufsize := Length(qualifiedpathbuf);
newinfoline := 'PathSearchAndQualify called with ' + pathtotest;
Memo1.Lines.Add(newinfoline);
apiretval := PathSearchAndQualify(PChar(pathtotest), qualifiedpathbuf, bufsize);
IF apiretval THEN
newinfoline := 'TRUE ' + qualifiedpathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//END Do NOT publish !!!
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathQuoteSpaces(Sender : TObject);
VAR pathbuf : ARRAY[0..MAX_PATH] OF CHAR;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
FillChar(pathbuf, Length(pathbuf), #0);
apiretval := FALSE;
newinfoline := '';
pathbuf := 'C:\Hello World !';
newinfoline := 'PathQuoteSpaces called with ' + pathbuf;
Memo1.Lines.Add(newinfoline);
apiretval := PathQuoteSpaces(pathbuf);
IF apiretval THEN
newinfoline := 'TRUE ' + pathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathbuf := 'C:\Hello\World';
newinfoline := 'PathQuoteSpaces called with ' + pathbuf;
Memo1.Lines.Add(newinfoline);
apiretval := PathQuoteSpaces(pathbuf);
IF apiretval THEN
newinfoline := 'TRUE ' + pathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPPathUnquoteSpaces(Sender : TObject);
VAR pathbuf : ARRAY[0..MAX_PATH] OF CHAR;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
FillChar(pathbuf, Length(pathbuf), #0);
apiretval := FALSE;
newinfoline := '';
pathbuf := '"C:\Hello World !"';
newinfoline := 'PathUnquoteSpaces called with ' + pathbuf;
Memo1.Lines.Add(newinfoline);
apiretval := PathUnquoteSpaces(pathbuf);
IF apiretval THEN
newinfoline := 'TRUE ' + pathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathbuf := '"C:\Hello\World"';
newinfoline := 'PathUnquoteSpaces called with ' + pathbuf;
Memo1.Lines.Add(newinfoline);
apiretval := PathUnquoteSpaces(pathbuf);
IF apiretval THEN
newinfoline := 'TRUE ' + pathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIPathMakePretty(Sender : TObject);
VAR pathbuf : ARRAY[0..MAX_PATH] OF CHAR;
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
FillChar(pathbuf, Length(pathbuf), #0);
apiretval := FALSE;
newinfoline := '';
pathbuf := 'C:\Hello\World';
newinfoline := 'PathMakePretty called with ' + pathbuf;
Memo1.Lines.Add(newinfoline);
apiretval := PathMakePretty(pathbuf);
IF apiretval THEN
newinfoline := 'TRUE ' + pathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathbuf := 'C:\PROGRAM FILES\MICROSOFT';
newinfoline := 'PathMakePretty called with ' + pathbuf;
Memo1.Lines.Add(newinfoline);
apiretval := PathMakePretty(pathbuf);
IF apiretval THEN
newinfoline := 'TRUE ' + pathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
pathbuf := 'C:\WINDOWS\System32\en-US';
newinfoline := 'PathMakePretty called with ' + pathbuf;
Memo1.Lines.Add(newinfoline);
apiretval := PathMakePretty(pathbuf);
IF apiretval THEN
newinfoline := 'TRUE ' + pathbuf
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIGetAcceptLanguages(Sender : TObject);
//Support for function as ordinal 14 & 15 under Win 98 SE (with IE 5.0) confirmed !!!
VAR acceptedlangsbuf : ARRAY[0..128] OF CHAR;
VAR bufsize : DWORD;
VAR apiretval : HRESULT;
VAR newinfoline : STRING;
BEGIN
FillChar(acceptedlangsbuf, Length(acceptedlangsbuf), #0);
bufsize := 0;
apiretval := 0; // = S_OK
newinfoline := '';
bufsize := 0;
apiretval := GetAcceptLanguages(NIL, @bufsize); //Returns the required buffer size !
//Set buffer size to bufsize (returned by call in previouse line)
bufsize := Length(acceptedlangsbuf);
apiretval := GetAcceptLanguages(acceptedlangsbuf, @bufsize);
IF apiretval = S_OK THEN
newinfoline := 'GetAcceptLanguages returned : ' + acceptedlangsbuf
ELSE
newinfoline := 'returned error code : ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIColorAdjustLuma(Sender : TObject);
VAR bmp : TBitmap;
VAR bmprect : TRect;
VAR originalcolor : COLORREF;
VAR newluma : INTEGER;
VAR modifiedcolor : COLORREF;
VAR colorname : STRING;
VAR newinfoline : STRING;
BEGIN
bmp := NIL;
FillChar(bmprect, SizeOf(bmprect), #0);
originalcolor := 0;
newluma := 0;
modifiedcolor := 0;
colorname := '';
newinfoline := '';
bmp := TBitmap.Create();
bmp.Width := 48;
bmp.Height := 48;
bmprect := Rect(0, 0, 48, 48);
originalcolor := $FF00FF;
bmp.Canvas.Brush.Color := originalcolor;
bmp.Canvas.FillRect(bmprect);
bmp.SaveToFile('OriginalColor1.bmp');
ColorToIdent(originalcolor, colorname);
newluma := 500;
newinfoline := 'ColorAdjustLuma called with 0x' + IntToHex(originalcolor, 8) +
' (' + IntToStr(originalcolor) + ')' + ' (' + colorname + ')' +
' and n = ' + IntToStr(newluma);
Memo1.Lines.Add(newinfoline);
modifiedcolor := ColorAdjustLuma(originalcolor, newluma, TRUE);
ColorToIdent(modifiedcolor, colorname);
newinfoline := 'Modified color : 0x' + IntToHex(modifiedcolor, 8) +
' (' + IntToStr(modifiedcolor) + ')' + ' (' + colorname + ')';
Memo1.Lines.Add(newinfoline);
bmp.Canvas.Brush.Color := modifiedcolor;
bmp.Canvas.FillRect(bmprect);
bmp.SaveToFile('AdjustedColor1.bmp');
originalcolor := $0000FF;
bmp.Canvas.Brush.Color := originalcolor;
bmp.Canvas.FillRect(bmprect);
bmp.SaveToFile('OriginalColor2.bmp');
ColorToIdent(originalcolor, colorname);
newinfoline := 'ColorAdjustLuma called with 0x' + IntToHex(originalcolor, 8) +
' (' + IntToStr(originalcolor) + ')' + ' (' + colorname + ')' +
' and n = ' + IntToStr(newluma);
Memo1.Lines.Add(newinfoline);
modifiedcolor := ColorAdjustLuma(originalcolor, newluma, FALSE);
ColorToIdent(modifiedcolor, colorname);
newinfoline := 'Modified color : 0x' + IntToHex(modifiedcolor, 8) +
' (' + IntToStr(modifiedcolor) + ')' + ' (' + colorname + ')';
Memo1.Lines.Add(newinfoline);
bmp.Canvas.Brush.Color := modifiedcolor;
bmp.Canvas.FillRect(bmprect);
bmp.SaveToFile('AdjustedColor2.bmp');
originalcolor := $808080;
bmp.Canvas.Brush.Color := originalcolor;
bmp.Canvas.FillRect(bmprect);
bmp.SaveToFile('OriginalColor3.bmp');
ColorToIdent(originalcolor, colorname);
newinfoline := 'ColorAdjustLuma called with 0x' + IntToHex(originalcolor, 8) +
' (' + IntToStr(originalcolor) + ')' + ' (' + colorname + ')' +
' and n = ' + IntToStr(newluma);
Memo1.Lines.Add(newinfoline);
modifiedcolor := ColorAdjustLuma(originalcolor, newluma, TRUE);
ColorToIdent(modifiedcolor, colorname);
newinfoline := 'Modified color : 0x' + IntToHex(modifiedcolor, 8) +
' (' + IntToStr(modifiedcolor) + ')' + ' (' + colorname + ')';
Memo1.Lines.Add(newinfoline);
bmp.Canvas.Brush.Color := modifiedcolor;
bmp.Canvas.FillRect(bmprect);
bmp.SaveToFile('AdjustedColor3.bmp');
Memo1.Lines.Add('');
bmp.Free();
END;
PROCEDURE TForm4.TestShlWAPIColorHLSToRGB(Sender : TObject);
VAR hue : WORD; //the H of the HLS
VAR luminance : WORD; //the L of the HLS
VAR saturation : WORD; //the S of the HLS
VAR rgbcolor : COLORREF;
VAR alpha : BYTE;
VAR red : BYTE;
VAR green : BYTE;
VAR blue : BYTE;
VAR newinfoline : STRING;
BEGIN
hue := 0;
luminance := 0;
saturation := 0;
rgbcolor := 0;
alpha := 0;
red := 0;
green := 0;
blue := 0;
newinfoline := '';
hue := 221;
luminance := 88;
saturation := 54;
rgbcolor := ColorHLSToRGB(hue, luminance, saturation);
newinfoline := 'ColorHLSToRGB called with a hue (H) value of 0x' +
IntToHex(hue, 4) + ' (' + IntToStr(hue) + '), ' +
'luminance (L) of 0x' + IntToHex(luminance, 4) + ' (' + IntToStr(luminance) + '), ' +
'saturation (S) of 0x' + IntToHex(saturation, 4) + ' (' + IntToStr(saturation) + '), ';
Memo1.Lines.Add(newinfoline);
alpha := HIBYTE(HIWORD(rgbcolor));
red := LOBYTE(HIWORD(rgbcolor));
green := HIBYTE(LOWORD(rgbcolor));
blue := LOBYTE(LOWORD(rgbcolor));
newinfoline := 'returned a red (R), green (G), blue (B) value of : 0x' +
IntToHex(rgbcolor, 8) + ' (' + IntToStr(red) + ', ' +
IntToStr(green) + ', ' + IntToStr(blue) + ')';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIColorRGBToHLS(Sender : TObject);
VAR rgbcolor : COLORREF;
VAR hue : WORD; //the H of the HLS
VAR luminance : WORD; //the L of the HLS
VAR saturation : WORD; //the S of the HLS
VAR newinfoline : STRING;
BEGIN
rgbcolor := 0;
hue := 0;
luminance := 0;
saturation := 0;
newinfoline := '';
rgbcolor := $005C4873;
ColorRGBToHLS(rgbcolor, @hue, @luminance, @saturation);
newinfoline := 'ColorRGBToHLS called with a RGB value of 0x' + IntToHex(rgbcolor, 8) +
' (' + IntToStr(rgbcolor) + ')';
Memo1.Lines.Add(newinfoline);
newinfoline := 'returned a hue (H) of ' + IntToStr(hue) +
', a luminance (L) of ' + IntToStr(luminance) +
', and a saturation (S) of ' + IntToStr(saturation);
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIwvnsprintf(Sender : TObject);
VAR formattedstr : ARRAY[0 .. 64] OF CHAR;
VAR formattedstrp : PChar;
VAR fmt : STRING;
VAR arg1 : STRING;
VAR arg2 : INTEGER;
VAR arg3 : STRING;
VAR arg4 : WORD;
VAR arg5 : STRING;
VAR arg6 : WORD;
VAR arglist : ARRAY[1..4] OF POINTER;
VAR arglistp : POINTER;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
FillChar(formattedstr, Length(formattedstr), #0);
formattedstrp := NIL;
fmt := '';
arg1 := '';
arg2 := 0;
arg3 := '';
arg4 := 0;
arglistp := NIL;
apiretval := 0;
newinfoline := '';
//What's forty two ? The answer is : 6 x 7
//fmt := '%6s %d %10s %d %3s %d';
fmt := '%6s %d %1s';
arg1 := 'What''s';
arg2 := 42;
arg3 := '?';
arglist[1] := PChar(arg1);
arglist[2] := POINTER(arg2);
arglist[3] := PChar(arg3);
newinfoline := 'wvnsprintf called with ' + arg1 + ' and ' + IntToStr(arg2) + ' and ' + arg3;
Memo1.Lines.Add(newinfoline);
apiretval := wvnsprintf(formattedstr, Length(formattedstr) - 1, PChar(fmt), @arglist);
IF apiretval > 0 THEN
newinfoline := formattedstr
ELSE
newinfoline := IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
formattedstrp := StrAlloc(64);
//rmattedstrp := StrAlloc(5);
arg3 := 'The answer is : ';
arg4 := 6;
arg5 := ' x ';
arg6 := 7;
fmt := '%16s %d %3s %d';
arglist[1] := PChar(arg3);
arglist[2] := POINTER(arg4);
arglist[3] := PChar(arg5);
arglist[4] := POINTER(arg6);
newinfoline := 'wvnsprintf called with "' + arg3 + '" and "' + IntToStr(arg4) +
'" and "' + arg5 + '" and "' + IntToStr(arg6) + '"';
Memo1.Lines.Add(newinfoline);
arglistp := @arglist;
apiretval := wvnsprintf(formattedstrp, StrBufSize(formattedstrp) - 1, PChar(fmt), arglistp);
IF apiretval > 0 THEN
newinfoline := formattedstrp
ELSE
BEGIN
newinfoline := IntToStr(apiretval);
//apiretval := INTEGER(GetLastError()); //For development purposes only !!!
END;
Memo1.Lines.Add(newinfoline);
StrDispose(formattedstrp);
//Contrary to some versions of the Microsoft documentation on this function
//the pointer specifier "p" is presumably supported as of Windows 2000.
//It is definitely supported under Vista with SP1 & IE 8.
fmt := '%43s%10p';
formattedstrp := StrAlloc(129);
arg1 := 'The address of the variable arglist is : 0x';
arg2 := INTEGER(@arglist);
newinfoline := 'wvnsprintf called with "' + arg1 + '" and "' + IntToStr(arg2) + '" (= @arglist)';
Memo1.Lines.Add(newinfoline);
arglist[1] := PChar(arg1);
arglist[2] := POINTER(arg2);
arglist[3] := NIL;
arglist[4] := NIL;
arglistp := @arglist;
apiretval := wvnsprintf(formattedstrp, StrBufSize(formattedstrp) - 1, PChar(fmt), arglistp);
IF apiretval > 0 THEN
newinfoline := formattedstrp
ELSE
newinfoline := IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
StrDispose(formattedstrp);
fmt := '%77s%8x';
formattedstrp := StrAlloc(129);
arg1 := 'The value of the variable arglist expressed in lower case, hex. notation : 0x';
arg2 := INTEGER(@arglist);
newinfoline := 'wvnsprintf called with "' + arg1 + '" and "' + IntToStr(arg2) + '" (= @arglist)';
Memo1.Lines.Add(newinfoline);
arglist[1] := PChar(arg1);
arglist[2] := POINTER(arg2);
arglist[3] := NIL;
arglist[4] := NIL;
arglistp := @arglist;
apiretval := wvnsprintf(formattedstrp, StrBufSize(formattedstrp) - 1, PChar(fmt), arglistp);
IF apiretval > 0 THEN
newinfoline := formattedstrp
ELSE
newinfoline := IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
StrDispose(formattedstrp);
fmt := '%77s%8X';
formattedstrp := StrAlloc(129);
arg1 := 'The value of the variable arglist expressed in upper case, hex. notation : 0x';
arg2 := INTEGER(@arglist);
newinfoline := 'wvnsprintf called with "' + arg1 + '" and "' + IntToStr(arg2) + '" (= @arglist)';
Memo1.Lines.Add(newinfoline);
arglist[1] := PChar(arg1);
arglist[2] := POINTER(arg2);
arglist[3] := NIL;
arglist[4] := NIL;
arglistp := @arglist;
apiretval := wvnsprintf(formattedstrp, StrBufSize(formattedstrp) - 1, PChar(fmt), arglistp);
IF apiretval > 0 THEN
newinfoline := formattedstrp
ELSE
newinfoline := IntToStr(apiretval);
Memo1.Lines.Add(newinfoline);
StrDispose(formattedstrp);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIIsInternetESCEnabled(Sender : TObject);
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
apiretval := FALSE;
newinfoline := '';
apiretval := IsInternetESCEnabled();
IF apiretval THEN
newinfoline := 'The call to IsInternetESCEnabled function returned TRUE (i.e. Enhanced Security Configuration is active)'
ELSE
newinfoline := 'The IsInternetESCEnabled function call returned FALSE (i.e. Enhanced Security Config. is NOT enabled)';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIIsOS(Sender : TObject);
//The import by ordinal 437 appears to be documented correctly !!!
VAR apiretval : BOOL;
VAR i : DWORD;
VAR newinfoline : STRING;
BEGIN
//osvaltotest := 0;
apiretval := FALSE;
i := 0;
newinfoline := '';
FOR i := OS_WINDOWS TO OS_APPLIANCE DO
BEGIN
apiretval := FALSE;
//IF i <> 4 THEN
BEGIN
CASE i OF
0 : newinfoline := 'OS_WINDOWS';
1 : newinfoline := ' OS_NT';
2 : newinfoline := ' OS_WIN95ORGREATER';
3 : newinfoline := ' OS_NT4ORGREATER';
4 : newinfoline := ' OS_WIN2000ORGREATER_ALT';
5 : newinfoline := ' OS_WIN98ORGREATER';
6 : newinfoline := ' OS_WIN98_GOLD';
7 : newinfoline := ' OS_WIN2000ORGREATER';
8 : newinfoline := ' OS_WIN2000PRO';
9 : newinfoline := ' OS_WIN2000SERVER';
10 : newinfoline := ' OS_WIN2000ADVSERVER';
11 : newinfoline := ' OS_WIN2000DATACENTER';
12 : newinfoline := ' OS_WIN2000TERMINAL';
13 : newinfoline := ' OS_EMBEDDED';
14 : newinfoline := ' OS_TERMINALCLIENT';
15 : newinfoline := ' OS_TERMINALREMOTEADMIN';
16 : newinfoline := ' OS_WIN95_GOLD';
17 : newinfoline := ' OS_MEORGREATER';
18 : newinfoline := ' OS_XPORGREATER';
19 : newinfoline := ' OS_HOME';
20 : newinfoline := ' OS_PROFESSIONAL';
21 : newinfoline := ' OS_DATACENTER';
22 : newinfoline := ' OS_ADVSERVER';
23 : newinfoline := ' OS_SERVER';
24 : newinfoline := ' OS_TERMINALSERVER';
25 : newinfoline := ' OS_PERSONALTERMINALSERVER';
26 : newinfoline := ' OS_FASTUSERSWITCHING';
27 : newinfoline := ' OS_WELCOMELOGONUI';
28 : newinfoline := ' OS_DOMAINMEMBER';
29 : newinfoline := ' OS_ANYSERVER';
30 : newinfoline := ' OS_WOW6432';
31 : newinfoline := ' OS_WEBSERVER';
32 : newinfoline := ' OS_SMALLBUSINESSSERVER';
33 : newinfoline := ' OS_TABLETPC';
34 : newinfoline := ' OS_SERVERADMINUI';
35 : newinfoline := ' OS_MEDIACENTER';
36 : newinfoline := ' OS_APPLIANCE';
END;
newinfoline := 'IsOS called with ' + newinfoline + ' (' + IntToStr(i) + ')';
Memo1.Lines.Add(newinfoline);
apiretval := IsOS(i) ;
IF apiretval THEN
newinfoline := 'TRUE'
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
END;
END;
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIMLFreeLibrary(Sender : TObject);
//Support for function as ordinal 418 under Win 98 SE (with IE 5.0) confirmed !!!
VAR apiretval : BOOL;
VAR newinfoline : STRING;
BEGIN
apiretval := FALSE;
newinfoline := '';
//ShowMessage('MLFreeLibrary');
newinfoline := 'MLFreeLibrary called with fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) +
' (' + IntToStr(fmlresmoduleh) + ') returned';
Memo1.Lines.Add(newinfoline);
apiretval := MLFreeLibrary(fmlresmoduleh);
IF apiretval = TRUE THEN
BEGIN
newinfoline := 'TRUE';
fmlresmoduleh := 0;
END
ELSE
newinfoline := 'FALSE';
Memo1.Lines.Add(newinfoline);
//Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIMLLoadLibrary(Sender : TObject);
//See doc. on function in Ms SDK version 6.0 and revise function declaration !!!
//Support for function as ordinal 377 & 378 under Win 98 SE (with IE 5.0) confirmed !!!
VAR loadedcodedllname : STRING;
VAR resdllname : STRING;
VAR loadedcodedllh : HMODULE;
VAR crosscodepg : DWORD;
//VAR resmoduleh : HMODULE;
VAR resmodulefilename : ARRAY[0 .. 259] OF CHAR;
VAR bufsize : DWORD;
VAR newinfoline : STRING;
BEGIN
//ShowMessage('MLLoadLibrary');
loadedcodedllname := '';
resdllname := '';
loadedcodedllh := 0;
crosscodepg := 0;
//resmoduleh := 0;
bufsize := 0;
bufsize := Length(resmodulefilename);
FillChar(resmodulefilename, bufsize, #0);
newinfoline := '';
loadedcodedllname := 'Shell32.dll';
loadedcodedllh := GetModuleHandle(PChar(loadedcodedllname));
resdllname := loadedcodedllname;
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and mddule handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('Shell32.dll', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'MMX32.dll';
loadedcodedllh := GetModuleHandle(PChar(loadedcodedllname));
resdllname := loadedcodedllname + '.mui';
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and mddule handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('MMX32.dll.mui', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'moricons.dll';
loadedcodedllh := GetModuleHandle(PChar(loadedcodedllname));
resdllname := loadedcodedllname;
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and mddule handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('moricons.dll', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'IEFrame.dll';
loadedcodedllh := GetModuleHandle(PChar(loadedcodedllname));
resdllname := loadedcodedllname;
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and mddule handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('IEFrame.dll', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'comdlg32.dll';
loadedcodedllh := GetModuleHandle(PChar(loadedcodedllname));
resdllname := 'NIL';
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and mddule handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
fmlresmoduleh := MLLoadLibrary(NIL, loadedcodedllh, crosscodepg);
//fmlresmoduleh := MLLoadLibrary('', loadedcodedllh, crosscodepg); //Produces the same result as the previous line !!!
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'comdlg32.dll';
loadedcodedllh := 0;
resdllname := loadedcodedllname;
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and mddule handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('comdlg32.dll', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'comdlg32.dll';
loadedcodedllh := GetModuleHandle(PChar(loadedcodedllname));
resdllname := loadedcodedllname;
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and module handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('comdlg32.dll', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'comdlg32.dll';
loadedcodedllh := 0;
resdllname := loadedcodedllname + '.mui';
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and mddule handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('comdlg32.dll.mui', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
loadedcodedllname := 'comdlg32.dll';
loadedcodedllh := GetModuleHandle(PChar(loadedcodedllname));
resdllname := loadedcodedllname + '.mui';
//crosscodepg := ML_CROSSCODEPAGE_MASK; //None of the flags seem to have any influence on the results under Vista with SP1 !
newinfoline := 'MLLoadLibrary called with ' + resdllname + ' and module handle 0x' +
IntToHex(loadedcodedllh, 8) + ' for ' + loadedcodedllname + ' returned : ';
Memo1.Lines.Add(newinfoline);
//fmlresmoduleh := MLLoadLibrary('comdlg32.dll.mui', loadedcodedllh, crosscodepg);
fmlresmoduleh := MLLoadLibrary(PChar(resdllname), loadedcodedllh, crosscodepg);
newinfoline := 'fmlresmoduleh = 0x' + IntToHex(fmlresmoduleh, 8) + ' (' + IntToStr(fmlresmoduleh) + ') ';
IF (fmlresmoduleh <> 0) AND (fmlresmoduleh <> INVALID_HANDLE_VALUE) THEN
BEGIN
GetModuleFileName(fmlresmoduleh, resmodulefilename, bufsize);
newinfoline := newinfoline + ' ("' + resmodulefilename + '")';
Memo1.Lines.Add(newinfoline);
TestShlWAPIMLFreeLibrary(Sender);
END
ELSE
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIWhichPlatform(Sender : TObject);
VAR apiretval : UINT;
VAR newinfoline : STRING;
BEGIN
apiretval := 0;
newinfoline := '';
apiretval := WhichPlatform();
newinfoline := 'Function WhichPlatform returned : ' + IntToStr(apiretval);
CASE apiretval OF
PLATFORM_UNKNOWN : newinfoline := newinfoline + ' (PLATFORM_UNKNOWN)';
PLATFORM_BROWSERONLY : newinfoline := newinfoline + ' (PLATFORM_BROWSERONLY)';
PLATFORM_INTEGRATED : newinfoline := newinfoline + ' (PLATFORM_INTEGRATED)';
END;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIAssocGetPerceivedType(Sender : TObject);
VAR apiretval : HRESULT;
VAR wcharsuffix : WideString;
VAR perceivedtype : PERCEIVED;
VAR typeflag : PERCEIVEDFLAG;
VAR wchartypestrp : PWideChar;
VAR newinfoline : STRING;
BEGIN
apiretval := 0;
wcharsuffix := '';
perceivedtype := 0;
typeflag := 0;
wchartypestrp := NIL;
newinfoline := '';
wcharsuffix := '.txt';
newinfoline := 'AssocGetPerceivedType called for ' + '.txt';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) + ' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.cpp';
newinfoline := 'AssocGetPerceivedType called for ' + '.cpp';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.hta';
newinfoline := 'AssocGetPerceivedType called for ' + '.hta';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.bmp';
newinfoline := 'AssocGetPerceivedType called for ' + '.bmp';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.wav';
newinfoline := 'AssocGetPerceivedType called for ' + '.wav';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.avi';
newinfoline := 'AssocGetPerceivedType called for ' + '.avi';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.rtf';
newinfoline := 'AssocGetPerceivedType called for ' + '.rtf';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.doc';
newinfoline := 'AssocGetPerceivedType called for ' + '.doc';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.zip';
newinfoline := 'AssocGetPerceivedType called for ' + '.zip';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.sys';
newinfoline := 'AssocGetPerceivedType called for ' + '.sys';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.drv';
newinfoline := 'AssocGetPerceivedType called for ' + '.drv';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.FCStd';
//wcharsuffix := '.flv';
newinfoline := 'AssocGetPerceivedType called for ' + '.FCStd';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
IF apiretval <> S_OK THEN
newinfoline := 'returned error code : ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')'
ELSE
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := '.flv';
newinfoline := 'AssocGetPerceivedType called for ' + '.flv';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
IF apiretval <> S_OK THEN
newinfoline := 'returned error code : ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')'
ELSE
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
apiretval := 0;
wcharsuffix := 'S:\SSTOffice\Private\Fitness2016.xls';
newinfoline := 'AssocGetPerceivedType called for ' + 'S:\SSTOffice\Private\Fitness2016.xls';
Memo1.Lines.Add(newinfoline);
apiretval := AssocGetPerceivedType(PWideChar(wcharsuffix), perceivedtype, typeflag, @wchartypestrp);
IF apiretval <> S_OK THEN
newinfoline := 'returned error code : ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')'
ELSE
newinfoline := AnsiQuotedStr(wchartypestrp, '"');
newinfoline := newinfoline + ', perceived type : ' + IntToStr(perceivedtype) +
' perceived flag : 0x' + IntToHex(typeflag, 4);
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPISHMessageBoxCheck(Sender : TObject);
//Existence as ordinal 185 tested and confirmed under
//Windows 2003 (with SP 2)
VAR wndhandle : HWND;
VAR messagetext : STRING;
VAR wcharmsgtxt : WideString;
VAR msgboxtitle : STRING;
VAR wchardlgtitle : WideString;
VAR msgboxtype : UINT;
VAR defretval : INTEGER;
VAR registryvalstr : STRING;
VAR wcharregvalstr : WideString;
VAR apiretval : INTEGER;
VAR newinfoline : STRING;
BEGIN
wndhandle := 0;
messagetext := '';
wcharmsgtxt := '';
msgboxtitle := '';
wchardlgtitle := '';
msgboxtype := 0;
defretval := 0;
registryvalstr := '';
wcharregvalstr := '';
apiretval := 0;
newinfoline := '';
wndhandle := Handle;
messagetext := 'Hello World !' + #13 + #10 +
'ShlWAPI function test completed.';
//Under Windows 2003 and later, it is not necessary to
//append a question such as the following to the message box's text,
//a text to the same effect is already added to the dialog by Windows
//" + #13 + #10 + 'Always show this message ?';"
msgboxtitle := 'SHMessageBoxCheck Test';
//The following line sets the "Ok" button as the default button
//(i.e. the question "In the future, do not show me this dialog box"
//is answered with "Ok" if the user closes the dialog by pressing Enter/Return).
//However, only the state of the check box has any influence on whether the
//the dialog is shown again or not.
//To return to the initial behaviour of the app, set the string in the
//registry value "TestShlWAPIFunctions3{9F430225-F4CB-4A7E-B717-0C118D8FAC69}", under
//"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\DontShowMeThisDialogAgain"
//to "YES", or simply delete the value.
msgboxtype := MB_OKCANCEL OR MB_DEFBUTTON1 OR MB_ICONINFORMATION;
defretval := $FFFF;
registryvalstr := 'TestShlWAPIFunctions3' + '{9F430225-F4CB-4A7E-B717-0C118D8FAC69}';
apiretval := SHMessageBoxCheck(wndhandle, PChar(messagetext), PChar(msgboxtitle),
msgboxtype, defretval, PChar(registryvalstr));
newinfoline := 'SHMessageBoxCheck returned ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
msgboxtype := MB_ABORTRETRYIGNORE OR MB_DEFBUTTON3 OR MB_ICONERROR;
//Combine bit 29, indicating a non-system (i.e. app) specific error with
//an arbitrary, unique value, specific to this particular dialog or class/group of dialogs.
defretval := $20000000 OR $8080;
//messagetext := 'Tests the veracity of the Microsoft doc. on this function !' + #13 + #10 +
// 'This message box should be ignored.';
wcharmsgtxt := 'If this message is displayed, SHMessageBoxCheckW is exported as ordinal 191.' + #13 + #10 +
'This message box should be ignored.';
wchardlgtitle := msgboxtitle;
//registryvalstr := 'TestShlWAPIFunctions3' + '{81EE5244-6596-4154-BCCB-6F6E6970A7F0}';
wcharregvalstr := 'TestShlWAPIFunctions3' + '{81EE5244-6596-4154-BCCB-6F6E6970A7F0}';
//apiretval := SHMessageBoxCheck(wndhandle, PChar(messagetext), PChar(msgboxtitle),
// msgboxtype, defretval, PChar(registryvalstr));
apiretval := SHMessageBoxCheckW(wndhandle, PWChar(wcharmsgtxt), PWChar(wchardlgtitle),
msgboxtype, defretval, PWChar(wcharregvalstr));
newinfoline := 'SHMessageBoxCheck returned ' + IntToStr(apiretval) + ' (0x' + IntToHex(apiretval, 8) + ')';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPISHStripMneumonic(Sender : TObject);
VAR mnuitemcaption : STRING;
VAR apiretval : CHAR;
VAR newinfoline : STRING;
BEGIN
mnuitemcaption := '';
apiretval := #0;
newinfoline := '';
//ShowMessage('SHStripMneumonic');
mnuitemcaption := MMHelpAbout.Caption;
newinfoline := 'The caption of the "Help -> About" menu item is : ' + mnuitemcaption;
Memo1.Lines.Add(newinfoline);
apiretval := SHStripMneumonic(PChar(mnuitemcaption));
IF apiretval <> #0 THEN
BEGIN
newinfoline := 'The caption from which mnemonic was removed is now "' + PChar(mnuitemcaption) + '".';
Memo1.Lines.Add(newinfoline);
newinfoline := 'The character from which the mnemonic was stripped is : "' + apiretval + '"';
END
ELSE
BEGIN
newinfoline := 'Stripping the mnemonic from "' + mnuitemcaption + '" failed !';
END;
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestFindResourceWrapW(Sender : TObject);
VAR resmoduleh : THandle;
VAR restypeid : INTEGER;
VAR resnameid : INTEGER;
VAR restypewstr : WideString;
VAR resnamewstr : WideString;
VAR resinfoblckh : HRSRC;
VAR reshandle : HGLOBAL;
VAR resdatap : POINTER;
VAR resdatasize : DWORD;
VAR memstream : TMemoryStream;
VAR resicon : TIcon;
VAR newinfoline : STRING;
BEGIN
resmoduleh := 0;
restypeid := 0;
resnameid := 0;
restypewstr := '';
resnamewstr := '';
resinfoblckh := 0;
reshandle := 0;
resdatap := NIL;
resdatasize := 0;
memstream := NIL;
resicon := NIL;
newinfoline := '';
//ShowMessage('TestFindResourceWrapW');
restypeid := 24; //Application Manifest
resnameid := 1;
resinfoblckh := FindResourceWrapW(resmoduleh, PWChar(resnameid), PWChar(restypeid));
IF resinfoblckh <> 0 THEN
BEGIN
reshandle := LoadResource(resmoduleh, resinfoblckh);
IF reshandle <> 0 THEN
resdatap := LockResource(reshandle);
IF resdatap <> NIL THEN
newinfoline := PChar(resdatap);
IF newinfoline <> '' THEN
Memo1.Lines.Add(newinfoline)
ELSE
TestShlWAPIOutputDebugStringWrapW(Sender);
END
ELSE
TestShlWAPIOutputDebugStringWrapW(Sender);
restypeid := 0;
resnameid := 0;
restypewstr := 'GIF'; //Graphics Interchange Format (GIF) image
resnamewstr := 'MAINICONGIF';
resinfoblckh := FindResourceWrapW(resmoduleh, PWChar(resnamewstr), PWChar(restypewstr));
IF resinfoblckh <> 0 THEN
BEGIN
reshandle := LoadResource(resmoduleh, resinfoblckh);
IF reshandle <> 0 THEN
resdatap := LockResource(reshandle);
resdatasize := SizeofResource(resmoduleh, resinfoblckh);
memstream := TMemoryStream.Create();
memstream.WriteBuffer(resdatap^, resdatasize);
memstream.SaveToFile('MAINICONGIF.Gif');
memstream.Free();
END
ELSE
TestShlWAPIOutputDebugStringWrapW(Sender);
restypewstr := '';
restypewstr := '#3'; //Icon
resnamewstr := '#1';
resinfoblckh := FindResourceWrapW(resmoduleh, PWChar(resnamewstr), PWChar(restypewstr));
IF resinfoblckh <> 0 THEN
BEGIN
reshandle := LoadResource(resmoduleh, resinfoblckh);
IF reshandle <> 0 THEN
resdatap := LockResource(reshandle);
resdatasize := SizeofResource(resmoduleh, resinfoblckh);
resicon := TIcon.Create();
resicon.Handle := CreateIconFromResourceEx(resdatap, resdatasize, TRUE, $00030000, 0, 0, LR_DEFAULTCOLOR);
resicon.SaveToFile('Delphi5MAINICON.ico');
resicon.Free();
END
ELSE
TestShlWAPIOutputDebugStringWrapW(Sender);
newinfoline := '';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.TestShlWAPIOutputDebugStringWrapW(Sender : TObject);
VAR lastrecerr : INTEGER;
VAR dbginfo : WideString;
BEGIN
lastrecerr := 0;
dbginfo := '';
lastrecerr := INTEGER(GetLastError());
dbginfo := 'GetLastError returned ' + IntToStr(lastrecerr);
OutputDebugStringWrapW(PWChar(dbginfo));
Memo1.Lines.Add(dbginfo);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.ListExampleFunctions(Sender : TObject);
//List names of ShlWAPI.dll functions for which this app provides
//a usage and functionality example
VAR newinfoline : STRING;
BEGIN
newinfoline := '';
newinfoline := 'AssocGetPerceivedType';
Memo1.Lines.Add(newinfoline);
newinfoline := 'ColorAdjustLuma';
Memo1.Lines.Add(newinfoline);
newinfoline := 'ColorHLSToRGB';
Memo1.Lines.Add(newinfoline);
newinfoline := 'ColorRGBToHLS';
Memo1.Lines.Add(newinfoline);
newinfoline := 'DllGetVersion';
Memo1.Lines.Add(newinfoline);
newinfoline := 'FindResourceWrapW';
Memo1.Lines.Add(newinfoline);
newinfoline := 'GetAcceptLanguages';
Memo1.Lines.Add(newinfoline);
newinfoline := 'IsInternetESCEnabled';
Memo1.Lines.Add(newinfoline);
newinfoline := 'IsOS';
Memo1.Lines.Add(newinfoline);
newinfoline := 'MakeDllVerULL';
Memo1.Lines.Add(newinfoline);
newinfoline := 'MLFreeLibrary';
Memo1.Lines.Add(newinfoline);
newinfoline := 'MLLoadLibrary';
Memo1.Lines.Add(newinfoline);
newinfoline := 'OutputDebugStringWrapW';
Memo1.Lines.Add(newinfoline);
newinfoline := 'ParseURL';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathAddExtension';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathCombine';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathCreateFromUrl';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathFileExists';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathFindNextComponent';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathFindOnPath';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathFindSuffixArray';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathGetArgs';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathGetDriveNumber';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathIsDirectory';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathIsLFNFileSpec';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathIsRoot';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathIsSystemFolder';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathIsUNC';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathMakePretty';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathQuoteSpaces';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathSearchAndQualify';
Memo1.Lines.Add(newinfoline);
newinfoline := 'PathUnquoteSpaces';
Memo1.Lines.Add(newinfoline);
newinfoline := 'SHFormatDateTime';
Memo1.Lines.Add(newinfoline);
newinfoline := 'SHMessageBoxCheck';
Memo1.Lines.Add(newinfoline);
newinfoline := 'SHStripMneumonic';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrFormatByteSizeA';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrFormatByteSizeW';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrFormatByteSize64A';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrFormatByteSizeEx';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrFormatKBSize';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrFromTimeInterval';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrToInt64Ex';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrToInt';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrToIntEx';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrCSpn';
Memo1.Lines.Add(newinfoline);
newinfoline := 'StrSpn';
Memo1.Lines.Add(newinfoline);
newinfoline := 'WhichPlatform';
Memo1.Lines.Add(newinfoline);
newinfoline := 'wvnsprintf';
Memo1.Lines.Add(newinfoline);
Memo1.Lines.Add('');
END;
PROCEDURE TForm4.FindText(Sender : TObject);
VAR newdlgpos : TPoint;
VAR dlgretval : BOOLEAN;
BEGIN
newdlgpos.x := 0;
newdlgpos.y := 0;
dlgretval := FALSE;
dlgretval := FindDialog1.Execute();
END;
PROCEDURE TForm4.OnFindDialogFind(Sender : TObject);
VAR txttofind : STRING;
VAR focusedlvitem : TListItem;
VAR searchstartindx : INTEGER;
VAR foundlvitem : TListItem;
BEGIN
txttofind := '';
focusedlvitem := NIL;
searchstartindx := 0;
foundlvitem := NIL;
txttofind := FindDialog1.FindText;
IF txttofind <> '' THEN
BEGIN
IF ActiveControl = ListView1 THEN
BEGIN
focusedlvitem := ListView1.ItemFocused;
//IF focusedlvitem <> NIL THEN
// BEGIN
// searchstartindx := focusedlvitem.Index;
// IF searchstartindx <=
// END;
IF foundlvitem <> NIL THEN
BEGIN
foundlvitem.Selected := TRUE;
foundlvitem.Focused := TRUE;
foundlvitem.MakeVisible(FALSE);
ListView1.SetFocus();
END;
//ELSE //
END;
END
//ELSE
END;
PROCEDURE TForm4.ExitApplication(Sender: TObject);
BEGIN
Close();
END;
FUNCTION TForm4.GetDllHandle(adllanme : STRING) : HMODULE;
VAR rethandle : HMODULE;
BEGIN
rethandle := 0;
rethandle := GetModuleHandle(PChar(adllanme));
GetDllHandle := rethandle;
END;
FUNCTION TForm4.IsDllVerInfoImplemted(adllhandle : HMODULE; VAR aprocaddr : POINTER) : BOOLEAN;
VAR retval : BOOLEAN;
//VAR procaddr : POINTER;
BEGIN
retval := FALSE;
//procaddr := NIL;
IF (adllhandle <> 0) AND (adllhandle <> INVALID_HANDLE_VALUE) THEN
BEGIN
aprocaddr := GetProcAddress(adllhandle, 'DllGetVersion');
IF aprocaddr <> NIL THEN
retval := TRUE;
END;
IsDllVerInfoImplemted := retval;
END;
FUNCTION TForm4.GetDllVersionInfoVer(aprocaddr : POINTER; VAR adllverinforec : TDllVersionInfo2) : INTEGER;
//Although some DllGetVersion implementations, may return the size of
//the supported record when called with the cbSize member set to 0,
//others may not. It is thus safer to call the function with the
//larger record first and evaluate the return value.
VAR retval : INTEGER;
VAR getverretval : HRESULT;
VAR newinfoline : STRING;
BEGIN
retval := 0;
getverretval := 0;
newinfoline := '';
IF aprocaddr <> NIL THEN
BEGIN
adllverinforec.info1.cbSize := SizeOf(adllverinforec);
getverretval := TDllGetVersionProc(aprocaddr)(@adllverinforec);
//getverretval := $800700EA; //$8007 OR ERROR_MORE_DATA (= 234)
IF getverretval <> S_OK THEN
newinfoline := 'returned error code : ' + IntToStr(getverretval) + ' (0x' + IntToHex(getverretval, 8) + ')';
IF getverretval = S_OK THEN
retval := 2
ELSE
retval := 1;
END
ELSE
retval := - 1;
GetDllVersionInfoVer := retval;
END;
FUNCTION TForm4.GetDllVersionInfo(aprocaddr : POINTER; VAR adllverinforec : TDllVersionInfo) : BOOLEAN;
VAR retval : BOOLEAN;
VAR getverretval : HRESULT;
BEGIN
retval := FALSE;
getverretval := 0;
IF aprocaddr <> NIL THEN
BEGIN
FillChar(adllverinforec, SizeOf(adllverinforec), #0);
adllverinforec.cbSize := SizeOf(adllverinforec);
getverretval := TDllGetVersionProc(aprocaddr)(@adllverinforec);
IF getverretval = S_OK THEN
retval := TRUE;
END;
GetDllVersionInfo := retval;
END;
FUNCTION TForm4.GetDllVersionInfo2(aprocaddr : POINTER; VAR adllverinforec : TDllVersionInfo2) : BOOLEAN;
VAR retval : BOOLEAN;
VAR getverretval : HRESULT;
BEGIN
retval := FALSE;
getverretval := 0;
IF aprocaddr <> NIL THEN
BEGIN
FillChar(adllverinforec, SizeOf(adllverinforec), #0);
adllverinforec.info1.cbSize := SizeOf(adllverinforec);
getverretval := TDllGetVersionProc(aprocaddr)(@adllverinforec);
IF getverretval = S_OK THEN
retval := TRUE;
END;
GetDllVersionInfo2 := retval;
END;
end. |
| |
Download file
|
|
|
| Application Main Window Form |
| |
object Form4: TForm4
Left = 345
Top = 214
Width = 640
Height = 412
Caption = 'Form4'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = OnCreate
PixelsPerInch = 96
TextHeight = 13
object Splitter1: TSplitter
Left = 200
Top = 26
Width = 3
Height = 311
Cursor = crHSplit
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 624
Height = 26
Align = alTop
TabOrder = 0
object StaticText1: TStaticText
Left = 4
Top = 4
Width = 71
Height = 17
Caption = 'Selected file : '
TabOrder = 0
end
object SelFileComboBox1: TComboBox
Left = 92
Top = 2
Width = 441
Height = 21
Anchors = [akLeft, akTop, akRight]
ItemHeight = 13
TabOrder = 1
Text = 'SelFileComboBox1'
end
object BrowseButton1: TButton
Left = 544
Top = 1
Width = 75
Height = 23
Anchors = [akTop, akRight]
Caption = 'Browse ...'
TabOrder = 2
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 337
Width = 624
Height = 19
Panels = <>
ParentFont = True
SimplePanel = True
SimpleText = 'Test'
UseSystemFont = False
end
object Panel2: TPanel
Left = 0
Top = 26
Width = 200
Height = 311
Align = alLeft
Caption = 'Panel2'
TabOrder = 2
object ListView1: TListView
Left = 4
Top = 1
Width = 192
Height = 274
Anchors = [akLeft, akTop, akRight, akBottom]
Checkboxes = True
Columns = <
item
Caption = 'Function Name'
Width = 188
end>
Items.Data = {
EE3300007401000000000000FFFFFFFFFFFFFFFF00000000000000000B417373
6F6343726561746500000000FFFFFFFFFFFFFFFF000000000000000015417373
6F634765745065726365697665645479706500000000FFFFFFFFFFFFFFFF0000
000000000000104173736F63497344616E6765726F757300000000FFFFFFFFFF
FFFFFF00000000000000000E4173736F6351756572794B65794100000000FFFF
FFFFFFFFFFFF00000000000000000E4173736F6351756572794B657957000000
00FFFFFFFFFFFFFFFF0000000000000000114173736F63517565727953747269
6E674100000000FFFFFFFFFFFFFFFF0000000000000000164173736F63517565
7279537472696E6742794B65794100000000FFFFFFFFFFFFFFFF000000000000
0000164173736F635175657279537472696E6742794B65795700000000FFFFFF
FFFFFFFFFF0000000000000000114173736F635175657279537472696E675700
000000FFFFFFFFFFFFFFFF000000000000000008436872436D70494100000000
FFFFFFFFFFFFFFFF000000000000000008436872436D70495700000000FFFFFF
FFFFFFFFFF00000000000000000F436F6C6F7241646A7573744C756D61000000
00FFFFFFFFFFFFFFFF00000000000000000D436F6C6F72484C53546F52474200
000000FFFFFFFFFFFFFFFF00000000000000000D436F6C6F72524742546F484C
5300000000FFFFFFFFFFFFFFFF000000000000000018436F6E6E656374546F43
6F6E6E656374696F6E506F696E7400000000FFFFFFFFFFFFFFFF000000000000
00001444656C61794C6F61644661696C757265486F6F6B00000000FFFFFFFFFF
FFFFFF00000000000000000D446C6C47657456657273696F6E00000000FFFFFF
FFFFFFFFFF0000000000000000134765744163636570744C616E677561676573
4100000000FFFFFFFFFFFFFFFF0000000000000000134765744163636570744C
616E6775616765735700000000FFFFFFFFFFFFFFFF0000000000000000104765
744D656E75506F7346726F6D494400000000FFFFFFFFFFFFFFFF000000000000
000008486173684461746100000000FFFFFFFFFFFFFFFF000000000000000010
496E746C5374724571576F726B65724100000000FFFFFFFFFFFFFFFF00000000
0000000010496E746C5374724571576F726B65725700000000FFFFFFFFFFFFFF
FF00000000000000000C49734368617253706163654100000000FFFFFFFFFFFF
FFFF00000000000000000C49734368617253706163655700000000FFFFFFFFFF
FFFFFF0000000000000000144973496E7465726E6574455343456E61626C6564
00000000FFFFFFFFFFFFFFFF00000000000000000449734F5300000000FFFFFF
FFFFFFFFFF00000000000000000C4953747265616D5F436F707900000000FFFF
FFFFFFFFFFFF00000000000000000C4953747265616D5F5265616400000000FF
FFFFFFFFFFFFFF0000000000000000104953747265616D5F526561645069646C
00000000FFFFFFFFFFFFFFFF00000000000000000F4953747265616D5F526561
6453747200000000FFFFFFFFFFFFFFFF00000000000000000D4953747265616D
5F526573657400000000FFFFFFFFFFFFFFFF00000000000000000C4953747265
616D5F53697A6500000000FFFFFFFFFFFFFFFF00000000000000000D49537472
65616D5F577269746500000000FFFFFFFFFFFFFFFF0000000000000000114953
747265616D5F57726974655069646C00000000FFFFFFFFFFFFFFFF0000000000
000000104953747265616D5F577269746553747200000000FFFFFFFFFFFFFFFF
00000000000000001649556E6B6E6F776E5F41746F6D696352656C6561736500
000000FFFFFFFFFFFFFFFF00000000000000001049556E6B6E6F776E5F476574
5369746500000000FFFFFFFFFFFFFFFF00000000000000001249556E6B6E6F77
6E5F47657457696E646F7700000000FFFFFFFFFFFFFFFF000000000000000015
49556E6B6E6F776E5F51756572795365727669636500000000FFFFFFFFFFFFFF
FF00000000000000000C49556E6B6E6F776E5F53657400000000FFFFFFFFFFFF
FFFF00000000000000001049556E6B6E6F776E5F5365745369746500000000FF
FFFFFFFFFFFFFF00000000000000000D4D4C467265654C696272617279000000
00FFFFFFFFFFFFFFFF00000000000000000E4D4C4C6F61644C69627261727941
00000000FFFFFFFFFFFFFFFF00000000000000000E4D4C4C6F61644C69627261
72795700000000FFFFFFFFFFFFFFFF000000000000000009506172736555524C
4100000000FFFFFFFFFFFFFFFF000000000000000009506172736555524C5700
000000FFFFFFFFFFFFFFFF000000000000000011506174684164644261636B73
6C6173684100000000FFFFFFFFFFFFFFFF000000000000000011506174684164
644261636B736C6173685700000000FFFFFFFFFFFFFFFF000000000000000011
50617468416464457874656E73696F6E4100000000FFFFFFFFFFFFFFFF000000
00000000001150617468416464457874656E73696F6E5700000000FFFFFFFFFF
FFFFFF00000000000000000B50617468417070656E644100000000FFFFFFFFFF
FFFFFF00000000000000000B50617468417070656E645700000000FFFFFFFFFF
FFFFFF00000000000000000E506174684275696C64526F6F744100000000FFFF
FFFFFFFFFFFF00000000000000000E506174684275696C64526F6F7457000000
00FFFFFFFFFFFFFFFF0000000000000000115061746843616E6F6E6963616C69
7A654100000000FFFFFFFFFFFFFFFF0000000000000000115061746843616E6F
6E6963616C697A655700000000FFFFFFFFFFFFFFFF00000000000000000C5061
7468436F6D62696E654100000000FFFFFFFFFFFFFFFF00000000000000000C50
617468436F6D62696E655700000000FFFFFFFFFFFFFFFF000000000000000011
50617468436F6D6D6F6E5072656669784100000000FFFFFFFFFFFFFFFF000000
00000000001150617468436F6D6D6F6E5072656669785700000000FFFFFFFFFF
FFFFFF00000000000000001050617468436F6D70616374506174684100000000
FFFFFFFFFFFFFFFF00000000000000001250617468436F6D7061637450617468
45784100000000FFFFFFFFFFFFFFFF00000000000000001250617468436F6D70
6163745061746845785700000000FFFFFFFFFFFFFFFF00000000000000001050
617468436F6D70616374506174685700000000FFFFFFFFFFFFFFFF0000000000
000000125061746843726561746546726F6D55726C4100000000FFFFFFFFFFFF
FFFF0000000000000000165061746843726561746546726F6D55726C416C6C6F
6300000000FFFFFFFFFFFFFFFF00000000000000001250617468437265617465
46726F6D55726C5700000000FFFFFFFFFFFFFFFF00000000000000000F506174
6846696C654578697374734100000000FFFFFFFFFFFFFFFF0000000000000000
0F5061746846696C654578697374735700000000FFFFFFFFFFFFFFFF00000000
00000000125061746846696E64457874656E73696F6E4100000000FFFFFFFFFF
FFFFFF0000000000000000125061746846696E64457874656E73696F6E570000
0000FFFFFFFFFFFFFFFF0000000000000000115061746846696E6446696C654E
616D654100000000FFFFFFFFFFFFFFFF0000000000000000115061746846696E
6446696C654E616D655700000000FFFFFFFFFFFFFFFF00000000000000001650
61746846696E644E657874436F6D706F6E656E744100000000FFFFFFFFFFFFFF
FF0000000000000000165061746846696E644E657874436F6D706F6E656E7457
00000000FFFFFFFFFFFFFFFF00000000000000000F5061746846696E644F6E50
6174684100000000FFFFFFFFFFFFFFFF00000000000000000F5061746846696E
644F6E506174685700000000FFFFFFFFFFFFFFFF000000000000000014506174
6846696E6453756666697841727261794100000000FFFFFFFFFFFFFFFF000000
0000000000145061746846696E6453756666697841727261795700000000FFFF
FFFFFFFFFFFF00000000000000000C50617468476574417267734100000000FF
FFFFFFFFFFFFFF00000000000000000C50617468476574417267735700000000
FFFFFFFFFFFFFFFF000000000000000010506174684765744368617254797065
4100000000FFFFFFFFFFFFFFFF00000000000000001050617468476574436861
72547970655700000000FFFFFFFFFFFFFFFF0000000000000000135061746847
657444726976654E756D6265724100000000FFFFFFFFFFFFFFFF000000000000
0000135061746847657444726976654E756D6265725700000000FFFFFFFFFFFF
FFFF000000000000000012506174684973436F6E74656E745479706541000000
00FFFFFFFFFFFFFFFF000000000000000012506174684973436F6E74656E7454
7970655700000000FFFFFFFFFFFFFFFF00000000000000001050617468497344
69726563746F72794100000000FFFFFFFFFFFFFFFF0000000000000000105061
746849734469726563746F72795700000000FFFFFFFFFFFFFFFF000000000000
0000155061746849734469726563746F7279456D7074794100000000FFFFFFFF
FFFFFFFF0000000000000000155061746849734469726563746F7279456D7074
795700000000FFFFFFFFFFFFFFFF00000000000000000F50617468497346696C
65537065634100000000FFFFFFFFFFFFFFFF00000000000000000F5061746849
7346696C65537065635700000000FFFFFFFFFFFFFFFF00000000000000001250
61746849734C464E46696C65537065634100000000FFFFFFFFFFFFFFFF000000
0000000000125061746849734C464E46696C65537065635700000000FFFFFFFF
FFFFFFFF0000000000000000125061746849734E6574776F726B506174684100
000000FFFFFFFFFFFFFFFF0000000000000000125061746849734E6574776F72
6B506174685700000000FFFFFFFFFFFFFFFF00000000000000000D5061746849
735072656669784100000000FFFFFFFFFFFFFFFF00000000000000000D506174
6849735072656669785700000000FFFFFFFFFFFFFFFF00000000000000000F50
617468497352656C61746976654100000000FFFFFFFFFFFFFFFF000000000000
00000F50617468497352656C61746976655700000000FFFFFFFFFFFFFFFF0000
0000000000000B506174684973526F6F744100000000FFFFFFFFFFFFFFFF0000
0000000000000B506174684973526F6F745700000000FFFFFFFFFFFFFFFF0000
0000000000000F50617468497353616D65526F6F744100000000FFFFFFFFFFFF
FFFF00000000000000000F50617468497353616D65526F6F745700000000FFFF
FFFFFFFFFFFF00000000000000001350617468497353797374656D466F6C6465
724100000000FFFFFFFFFFFFFFFF000000000000000013506174684973537973
74656D466F6C6465725700000000FFFFFFFFFFFFFFFF00000000000000000A50
6174684973554E434100000000FFFFFFFFFFFFFFFF00000000000000000A5061
74684973554E435700000000FFFFFFFFFFFFFFFF000000000000000010506174
684973554E435365727665724100000000FFFFFFFFFFFFFFFF00000000000000
0010506174684973554E435365727665725700000000FFFFFFFFFFFFFFFF0000
00000000000015506174684973554E4353657276657253686172654100000000
FFFFFFFFFFFFFFFF000000000000000015506174684973554E43536572766572
53686172655700000000FFFFFFFFFFFFFFFF00000000000000000A5061746849
7355524C4100000000FFFFFFFFFFFFFFFF00000000000000000A506174684973
55524C5700000000FFFFFFFFFFFFFFFF00000000000000000F506174684D616B
655072657474794100000000FFFFFFFFFFFFFFFF00000000000000000F506174
684D616B655072657474795700000000FFFFFFFFFFFFFFFF0000000000000000
15506174684D616B6553797374656D466F6C6465724100000000FFFFFFFFFFFF
FFFF000000000000000015506174684D616B6553797374656D466F6C64657257
00000000FFFFFFFFFFFFFFFF00000000000000000E506174684D617463685370
65634100000000FFFFFFFFFFFFFFFF00000000000000000E506174684D617463
68537065635700000000FFFFFFFFFFFFFFFF000000000000000010506174684D
617463685370656345784100000000FFFFFFFFFFFFFFFF000000000000000010
506174684D617463685370656345785700000000FFFFFFFFFFFFFFFF00000000
000000001650617468506172736549636F6E4C6F636174696F6E4100000000FF
FFFFFFFFFFFFFF00000000000000001650617468506172736549636F6E4C6F63
6174696F6E5700000000FFFFFFFFFFFFFFFF0000000000000000105061746851
756F74655370616365734100000000FFFFFFFFFFFFFFFF000000000000000010
5061746851756F74655370616365735700000000FFFFFFFFFFFFFFFF00000000
00000000135061746852656C617469766550617468546F4100000000FFFFFFFF
FFFFFFFF0000000000000000135061746852656C617469766550617468546F57
00000000FFFFFFFFFFFFFFFF00000000000000000F5061746852656D6F766541
7267734100000000FFFFFFFFFFFFFFFF00000000000000000F5061746852656D
6F7665417267735700000000FFFFFFFFFFFFFFFF000000000000000014506174
6852656D6F76654261636B736C6173684100000000FFFFFFFFFFFFFFFF000000
0000000000145061746852656D6F76654261636B736C6173685700000000FFFF
FFFFFFFFFFFF0000000000000000115061746852656D6F7665426C616E6B7341
00000000FFFFFFFFFFFFFFFF0000000000000000115061746852656D6F766542
6C616E6B735700000000FFFFFFFFFFFFFFFF0000000000000000145061746852
656D6F7665457874656E73696F6E4100000000FFFFFFFFFFFFFFFF0000000000
000000145061746852656D6F7665457874656E73696F6E5700000000FFFFFFFF
FFFFFFFF0000000000000000135061746852656D6F766546696C655370656341
00000000FFFFFFFFFFFFFFFF0000000000000000135061746852656D6F766546
696C65537065635700000000FFFFFFFFFFFFFFFF000000000000000014506174
6852656E616D65457874656E73696F6E4100000000FFFFFFFFFFFFFFFF000000
0000000000145061746852656E616D65457874656E73696F6E5700000000FFFF
FFFFFFFFFFFF00000000000000001550617468536561726368416E645175616C
6966794100000000FFFFFFFFFFFFFFFF00000000000000001550617468536561
726368416E645175616C6966795700000000FFFFFFFFFFFFFFFF000000000000
00001350617468536574446C674974656D506174684100000000FFFFFFFFFFFF
FFFF00000000000000001350617468536574446C674974656D50617468570000
0000FFFFFFFFFFFFFFFF00000000000000000D50617468536B6970526F6F7441
00000000FFFFFFFFFFFFFFFF00000000000000000D50617468536B6970526F6F
745700000000FFFFFFFFFFFFFFFF00000000000000000E506174685374726970
506174684100000000FFFFFFFFFFFFFFFF00000000000000000E506174685374
726970506174685700000000FFFFFFFFFFFFFFFF000000000000000010506174
685374726970546F526F6F744100000000FFFFFFFFFFFFFFFF00000000000000
0010506174685374726970546F526F6F745700000000FFFFFFFFFFFFFFFF0000
0000000000000F50617468556E6465636F726174654100000000FFFFFFFFFFFF
FFFF00000000000000000F50617468556E6465636F726174655700000000FFFF
FFFFFFFFFFFF00000000000000001750617468556E457870616E64456E765374
72696E67734100000000FFFFFFFFFFFFFFFF0000000000000000175061746855
6E457870616E64456E76537472696E67735700000000FFFFFFFFFFFFFFFF0000
0000000000001750617468556E6D616B6553797374656D466F6C646572410000
0000FFFFFFFFFFFFFFFF00000000000000001750617468556E6D616B65537973
74656D466F6C6465725700000000FFFFFFFFFFFFFFFF00000000000000001250
617468556E71756F74655370616365734100000000FFFFFFFFFFFFFFFF000000
00000000001250617468556E71756F74655370616365735700000000FFFFFFFF
FFFFFFFF000000000000000008514953656172636800000000FFFFFFFFFFFFFF
FF00000000000000000D5348416C6C6F6353686172656400000000FFFFFFFFFF
FFFFFF00000000000000000C5348416E7369546F416E736900000000FFFFFFFF
FFFFFFFF00000000000000000F5348416E7369546F556E69636F646500000000
FFFFFFFFFFFFFFFF00000000000000000E53484175746F436F6D706C65746500
000000FFFFFFFFFFFFFFFF00000000000000000A5348436F70794B6579410000
0000FFFFFFFFFFFFFFFF00000000000000000A5348436F70794B657957000000
00FFFFFFFFFFFFFFFF00000000000000001153484372656174654D656D537472
65616D00000000FFFFFFFFFFFFFFFF0000000000000000145348437265617465
5368656C6C50616C6574746500000000FFFFFFFFFFFFFFFF0000000000000000
15534843726561746553747265616D4F6E46696C654100000000FFFFFFFFFFFF
FFFF000000000000000015534843726561746553747265616D4F6E46696C6557
00000000FFFFFFFFFFFFFFFF0000000000000000165348437265617465537472
65616D4F6E46696C65457800000000FFFFFFFFFFFFFFFF000000000000000015
534843726561746553747265616D5772617070657200000000FFFFFFFFFFFFFF
FF00000000000000000E534843726561746554687265616400000000FFFFFFFF
FFFFFFFF00000000000000001153484372656174655468726561645265660000
0000FFFFFFFFFFFFFFFF000000000000000011534844656C657465456D707479
4B65794100000000FFFFFFFFFFFFFFFF000000000000000011534844656C6574
65456D7074794B65795700000000FFFFFFFFFFFFFFFF00000000000000000C53
4844656C6574654B65794100000000FFFFFFFFFFFFFFFF00000000000000000C
534844656C6574654B65795700000000FFFFFFFFFFFFFFFF0000000000000000
12534844656C6574654F727068616E4B65794100000000FFFFFFFFFFFFFFFF00
0000000000000012534844656C6574654F727068616E4B65795700000000FFFF
FFFFFFFFFFFF00000000000000000E534844656C65746556616C756541000000
00FFFFFFFFFFFFFFFF00000000000000000E534844656C65746556616C756557
00000000FFFFFFFFFFFFFFFF0000000000000000105368656C6C4D6573736167
65426F784100000000FFFFFFFFFFFFFFFF0000000000000000105368656C6C4D
657373616765426F785700000000FFFFFFFFFFFFFFFF00000000000000000C53
48456E756D4B657945784100000000FFFFFFFFFFFFFFFF00000000000000000C
5348456E756D4B657945785700000000FFFFFFFFFFFFFFFF0000000000000000
0C5348456E756D56616C75654100000000FFFFFFFFFFFFFFFF00000000000000
000C5348456E756D56616C75655700000000FFFFFFFFFFFFFFFF000000000000
0000115348466F726D61744461746554696D654100000000FFFFFFFFFFFFFFFF
0000000000000000115348466F726D61744461746554696D655700000000FFFF
FFFFFFFFFFFF00000000000000000C53484672656553686172656400000000FF
FFFFFFFFFFFFFF0000000000000000105348476574496E7665727365434D4150
00000000FFFFFFFFFFFFFFFF00000000000000000E5348476574546872656164
52656600000000FFFFFFFFFFFFFFFF00000000000000000B534847657456616C
75654100000000FFFFFFFFFFFFFFFF00000000000000000B534847657456616C
75655700000000FFFFFFFFFFFFFFFF0000000000000000195348476574566965
77537461746550726F706572747942616700000000FFFFFFFFFFFFFFFF000000
00000000000F534849734368696C644F7253656C6600000000FFFFFFFFFFFFFF
FF000000000000000014534849734C6F774D656D6F72794D616368696E650000
0000FFFFFFFFFFFFFFFF00000000000000001453484C6F6164496E6469726563
74537472696E6700000000FFFFFFFFFFFFFFFF00000000000000000C53484C6F
636B53686172656400000000FFFFFFFFFFFFFFFF00000000000000001253484D
657373616765426F78436865636B4100000000FFFFFFFFFFFFFFFF0000000000
0000001253484D657373616765426F78436865636B5700000000FFFFFFFFFFFF
FFFF00000000000000001153484F70656E52656753747265616D324100000000
FFFFFFFFFFFFFFFF00000000000000001153484F70656E52656753747265616D
325700000000FFFFFFFFFFFFFFFF00000000000000001053484F70656E526567
53747265616D4100000000FFFFFFFFFFFFFFFF00000000000000001053484F70
656E52656753747265616D5700000000FFFFFFFFFFFFFFFF0000000000000000
1A534850726F70657274794261675F52656164537472416C6C6F6300000000FF
FFFFFFFFFFFFFF00000000000000000F53485175657279496E666F4B65794100
000000FFFFFFFFFFFFFFFF00000000000000000F53485175657279496E666F4B
65795700000000FFFFFFFFFFFFFFFF00000000000000000F5348517565727956
616C756545784100000000FFFFFFFFFFFFFFFF00000000000000000F53485175
65727956616C756545785700000000FFFFFFFFFFFFFFFF00000000000000000F
5348526567436C6F736555534B657900000000FFFFFFFFFFFFFFFF0000000000
00000011534852656743726561746555534B65794100000000FFFFFFFFFFFFFF
FF000000000000000011534852656743726561746555534B65795700000000FF
FFFFFFFFFFFFFF000000000000000016534852656744656C657465456D707479
55534B65794100000000FFFFFFFFFFFFFFFF0000000000000000165348526567
44656C657465456D70747955534B65795700000000FFFFFFFFFFFFFFFF000000
000000000013534852656744656C657465555356616C75654100000000FFFFFF
FFFFFFFFFF000000000000000013534852656744656C657465555356616C7565
5700000000FFFFFFFFFFFFFFFF00000000000000001253485265674475706C69
63617465484B657900000000FFFFFFFFFFFFFFFF00000000000000000F534852
6567456E756D55534B65794100000000FFFFFFFFFFFFFFFF0000000000000000
0F5348526567456E756D55534B65795700000000FFFFFFFFFFFFFFFF00000000
00000000115348526567456E756D555356616C75654100000000FFFFFFFFFFFF
FFFF0000000000000000115348526567456E756D555356616C75655700000000
FFFFFFFFFFFFFFFF0000000000000000145348526567476574426F6F6C555356
616C75654100000000FFFFFFFFFFFFFFFF000000000000000014534852656747
6574426F6F6C555356616C75655700000000FFFFFFFFFFFFFFFF000000000000
00000C5348526567476574496E745700000000FFFFFFFFFFFFFFFF0000000000
0000000D5348526567476574506174684100000000FFFFFFFFFFFFFFFF000000
00000000000D5348526567476574506174685700000000FFFFFFFFFFFFFFFF00
00000000000000105348526567476574555356616C75654100000000FFFFFFFF
FFFFFFFF0000000000000000105348526567476574555356616C756557000000
00FFFFFFFFFFFFFFFF00000000000000000E534852656747657456616C756541
00000000FFFFFFFFFFFFFFFF00000000000000000E534852656747657456616C
75655700000000FFFFFFFFFFFFFFFF00000000000000001A5348526567697374
657256616C696461746554656D706C61746500000000FFFFFFFFFFFFFFFF0000
0000000000000F53485265674F70656E55534B65794100000000FFFFFFFFFFFF
FFFF00000000000000000F53485265674F70656E55534B65795700000000FFFF
FFFFFFFFFFFF00000000000000001453485265675175657279496E666F55534B
65794100000000FFFFFFFFFFFFFFFF0000000000000000145348526567517565
7279496E666F55534B65795700000000FFFFFFFFFFFFFFFF0000000000000000
1253485265675175657279555356616C75654100000000FFFFFFFFFFFFFFFF00
000000000000001253485265675175657279555356616C75655700000000FFFF
FFFFFFFFFFFF00000000000000000D5348526567536574506174684100000000
FFFFFFFFFFFFFFFF00000000000000000D534852656753657450617468570000
0000FFFFFFFFFFFFFFFF0000000000000000105348526567536574555356616C
75654100000000FFFFFFFFFFFFFFFF0000000000000000105348526567536574
555356616C75655700000000FFFFFFFFFFFFFFFF000000000000000012534852
65675772697465555356616C75654100000000FFFFFFFFFFFFFFFF0000000000
0000001253485265675772697465555356616C75655700000000FFFFFFFFFFFF
FFFF000000000000000012534852656C65617365546872656164526566000000
00FFFFFFFFFFFFFFFF00000000000000001D534852756E496E64697265637452
6567436C69656E74436F6D6D616E6400000000FFFFFFFFFFFFFFFF0000000000
00000017534853656E644D65737361676542726F6164636173744100000000FF
FFFFFFFFFFFFFF000000000000000017534853656E644D65737361676542726F
6164636173745700000000FFFFFFFFFFFFFFFF00000000000000000E53485365
7454687265616452656600000000FFFFFFFFFFFFFFFF00000000000000000B53
4853657456616C75654100000000FFFFFFFFFFFFFFFF00000000000000000B53
4853657456616C75655700000000FFFFFFFFFFFFFFFF00000000000000000E53
48536B69704A756E6374696F6E00000000FFFFFFFFFFFFFFFF00000000000000
000953485374724475704100000000FFFFFFFFFFFFFFFF000000000000000009
53485374724475705700000000FFFFFFFFFFFFFFFF0000000000000000115348
53747269704D6E65756D6F6E69634100000000FFFFFFFFFFFFFFFF0000000000
00000011534853747269704D6E65756D6F6E69635700000000FFFFFFFFFFFFFF
FF00000000000000000F5348556E69636F6465546F416E736900000000FFFFFF
FFFFFFFFFF0000000000000000125348556E69636F6465546F556E69636F6465
00000000FFFFFFFFFFFFFFFF00000000000000000E5348556E6C6F636B536861
72656400000000FFFFFFFFFFFFFFFF00000000000000000B5374724361744275
66664100000000FFFFFFFFFFFFFFFF00000000000000000B5374724361744275
66665700000000FFFFFFFFFFFFFFFF00000000000000000C5374724361744368
61696E5700000000FFFFFFFFFFFFFFFF00000000000000000753747243617457
00000000FFFFFFFFFFFFFFFF0000000000000000075374724368724100000000
FFFFFFFFFFFFFFFF0000000000000000075374724368725700000000FFFFFFFF
FFFFFFFF000000000000000008537472436872494100000000FFFFFFFFFFFFFF
FF000000000000000008537472436872495700000000FFFFFFFFFFFFFFFF0000
000000000000095374724368724E495700000000FFFFFFFFFFFFFFFF00000000
00000000085374724368724E5700000000FFFFFFFFFFFFFFFF00000000000000
0008537472436D70434100000000FFFFFFFFFFFFFFFF00000000000000000853
7472436D70435700000000FFFFFFFFFFFFFFFF00000000000000000953747243
6D7049434100000000FFFFFFFFFFFFFFFF000000000000000009537472436D70
49435700000000FFFFFFFFFFFFFFFF000000000000000008537472436D704957
00000000FFFFFFFFFFFFFFFF00000000000000000E537472436D704C6F676963
616C5700000000FFFFFFFFFFFFFFFF000000000000000008537472436D704E41
00000000FFFFFFFFFFFFFFFF000000000000000008537472436D704E57000000
00FFFFFFFFFFFFFFFF0000000000000000085374724370794E5700000000FFFF
FFFFFFFFFFFF000000000000000009537472436D704E434100000000FFFFFFFF
FFFFFFFF000000000000000009537472436D704E435700000000FFFFFFFFFFFF
FFFF000000000000000009537472436D704E494100000000FFFFFFFFFFFFFFFF
000000000000000009537472436D704E495700000000FFFFFFFFFFFFFFFF0000
0000000000000A537472436D704E49434100000000FFFFFFFFFFFFFFFF000000
00000000000A537472436D704E49435700000000FFFFFFFFFFFFFFFF00000000
0000000007537472436D705700000000FFFFFFFFFFFFFFFF0000000000000000
075374724370795700000000FFFFFFFFFFFFFFFF000000000000000008537472
4353706E4100000000FFFFFFFFFFFFFFFF000000000000000008537472435370
6E5700000000FFFFFFFFFFFFFFFF0000000000000000095374724353706E4941
00000000FFFFFFFFFFFFFFFF0000000000000000095374724353706E49570000
0000FFFFFFFFFFFFFFFF0000000000000000075374724475704100000000FFFF
FFFFFFFFFFFF0000000000000000075374724475705700000000FFFFFFFFFFFF
FFFF000000000000000014537472466F726D61744279746553697A6536344100
000000FFFFFFFFFFFFFFFF000000000000000012537472466F726D6174427974
6553697A654100000000FFFFFFFFFFFFFFFF000000000000000012537472466F
726D61744279746553697A655700000000FFFFFFFFFFFFFFFF00000000000000
0013537472466F726D61744279746553697A65457800000000FFFFFFFFFFFFFF
FF000000000000000010537472466F726D61744B4253697A654100000000FFFF
FFFFFFFFFFFF000000000000000010537472466F726D61744B4253697A655700
000000FFFFFFFFFFFFFFFF00000000000000001453747246726F6D54696D6549
6E74657276616C4100000000FFFFFFFFFFFFFFFF000000000000000014537472
46726F6D54696D65496E74657276616C5700000000FFFFFFFFFFFFFFFF000000
00000000000F5374724973496E746C457175616C4100000000FFFFFFFFFFFFFF
FF00000000000000000F5374724973496E746C457175616C5700000000FFFFFF
FFFFFFFFFF0000000000000000085374724E4361744100000000FFFFFFFFFFFF
FFFF0000000000000000085374724E4361745700000000FFFFFFFFFFFFFFFF00
00000000000000085374725042726B4100000000FFFFFFFFFFFFFFFF00000000
00000000085374725042726B5700000000FFFFFFFFFFFFFFFF00000000000000
0008537472524368724100000000FFFFFFFFFFFFFFFF00000000000000000853
7472524368725700000000FFFFFFFFFFFFFFFF00000000000000000953747252
436872494100000000FFFFFFFFFFFFFFFF000000000000000009537472524368
72495700000000FFFFFFFFFFFFFFFF00000000000000000C537472526574546F
4253545200000000FFFFFFFFFFFFFFFF00000000000000000C53747252657454
6F4275664100000000FFFFFFFFFFFFFFFF00000000000000000C537472526574
546F4275665700000000FFFFFFFFFFFFFFFF00000000000000000C5374725265
74546F5374724100000000FFFFFFFFFFFFFFFF00000000000000000C53747252
6574546F5374725700000000FFFFFFFFFFFFFFFF000000000000000009537472
52537472494100000000FFFFFFFFFFFFFFFF0000000000000000095374725253
7472495700000000FFFFFFFFFFFFFFFF00000000000000000753747253706E41
00000000FFFFFFFFFFFFFFFF00000000000000000753747253706E5700000000
FFFFFFFFFFFFFFFF0000000000000000075374725374724100000000FFFFFFFF
FFFFFFFF0000000000000000075374725374725700000000FFFFFFFFFFFFFFFF
000000000000000008537472537472494100000000FFFFFFFFFFFFFFFF000000
000000000008537472537472495700000000FFFFFFFFFFFFFFFF000000000000
0000095374725374724E495700000000FFFFFFFFFFFFFFFF0000000000000000
085374725374724E5700000000FFFFFFFFFFFFFFFF00000000000000000D5374
72546F496E74363445784100000000FFFFFFFFFFFFFFFF00000000000000000D
537472546F496E74363445785700000000FFFFFFFFFFFFFFFF00000000000000
0009537472546F496E744100000000FFFFFFFFFFFFFFFF000000000000000009
537472546F496E745700000000FFFFFFFFFFFFFFFF00000000000000000B5374
72546F496E7445784100000000FFFFFFFFFFFFFFFF00000000000000000B5374
72546F496E7445785700000000FFFFFFFFFFFFFFFF0000000000000000085374
725472696D4100000000FFFFFFFFFFFFFFFF0000000000000000085374725472
696D5700000000FFFFFFFFFFFFFFFF00000000000000000F55726C4170706C79
536368656D654100000000FFFFFFFFFFFFFFFF00000000000000000F55726C41
70706C79536368656D655700000000FFFFFFFFFFFFFFFF000000000000000010
55726C43616E6F6E6963616C697A654100000000FFFFFFFFFFFFFFFF00000000
000000001055726C43616E6F6E6963616C697A655700000000FFFFFFFFFFFFFF
FF00000000000000000B55726C436F6D62696E654100000000FFFFFFFFFFFFFF
FF00000000000000000B55726C436F6D62696E655700000000FFFFFFFFFFFFFF
FF00000000000000000B55726C436F6D706172654100000000FFFFFFFFFFFFFF
FF00000000000000000B55726C436F6D706172655700000000FFFFFFFFFFFFFF
FF00000000000000001255726C43726561746546726F6D506174684100000000
FFFFFFFFFFFFFFFF00000000000000001255726C43726561746546726F6D5061
74685700000000FFFFFFFFFFFFFFFF00000000000000000A55726C4573636170
654100000000FFFFFFFFFFFFFFFF00000000000000000A55726C457363617065
5700000000FFFFFFFFFFFFFFFF00000000000000000955726C46697875705700
000000FFFFFFFFFFFFFFFF00000000000000000F55726C4765744C6F63617469
6F6E4100000000FFFFFFFFFFFFFFFF00000000000000000F55726C4765744C6F
636174696F6E5700000000FFFFFFFFFFFFFFFF00000000000000000B55726C47
6574506172744100000000FFFFFFFFFFFFFFFF00000000000000000B55726C47
6574506172745700000000FFFFFFFFFFFFFFFF00000000000000000855726C48
6173684100000000FFFFFFFFFFFFFFFF00000000000000000855726C48617368
5700000000FFFFFFFFFFFFFFFF00000000000000000655726C49734100000000
FFFFFFFFFFFFFFFF00000000000000000655726C49735700000000FFFFFFFFFF
FFFFFF00000000000000000F55726C49734E6F486973746F72794100000000FF
FFFFFFFFFFFFFF00000000000000000F55726C49734E6F486973746F72795700
000000FFFFFFFFFFFFFFFF00000000000000000C55726C49734F706171756541
00000000FFFFFFFFFFFFFFFF00000000000000000C55726C49734F7061717565
5700000000FFFFFFFFFFFFFFFF00000000000000000C55726C556E6573636170
654100000000FFFFFFFFFFFFFFFF00000000000000000C55726C556E65736361
70655700000000FFFFFFFFFFFFFFFF00000000000000000D5768696368506C61
74666F726D00000000FFFFFFFFFFFFFFFF00000000000000000A776E73707269
6E74664100000000FFFFFFFFFFFFFFFF00000000000000000A776E737072696E
74665700000000FFFFFFFFFFFFFFFF00000000000000000B77766E737072696E
74664100000000FFFFFFFFFFFFFFFF00000000000000000B77766E737072696E
74665700000000FFFFFFFFFFFFFFFF0000000000000000185348437265617465
5468726561645769746848616E646C6500000000FFFFFFFFFFFFFFFF00000000
0000000017534850726F70657274794261675F57726974654253545200000000
FFFFFFFFFFFFFFFF00000000000000001146696E645265736F75726365577261
705700000000FFFFFFFFFFFFFFFF0000000000000000154F7574707574446562
7567537472696E675772617000000000FFFFFFFFFFFFFFFF0000000000000000
0D4D616B65446C6C566572554C4C}
TabOrder = 0
ViewStyle = vsReport
end
object TestFunctionButton1: TButton
Left = 4
Top = 282
Width = 192
Height = 23
Anchors = [akLeft, akRight, akBottom]
Caption = 'Test Selected Functions'
TabOrder = 1
OnClick = TestSelectedFunction
end
end
object Panel3: TPanel
Left = 203
Top = 26
Width = 421
Height = 311
Align = alClient
Caption = 'Panel3'
TabOrder = 3
object Memo1: TMemo
Left = 1
Top = 1
Width = 416
Height = 274
Anchors = [akLeft, akTop, akRight, akBottom]
ScrollBars = ssVertical
TabOrder = 0
end
end
object MainMenu1: TMainMenu
Left = 4
object MainMenuFile: TMenuItem
Caption = 'File'
object MMFileOpen: TMenuItem
Caption = 'Open ...'
ShortCut = 16463
Visible = False
end
object MMFileSep1: TMenuItem
Caption = '-'
Visible = False
end
object MMFileListSampleFunctions: TMenuItem
Caption = 'List Sample Functions'
OnClick = ListExampleFunctions
end
object MMFileRunFunctionTests: TMenuItem
Caption = 'Run Function Tests'
OnClick = TestSelectedFunction
end
object MMFileSep2: TMenuItem
Caption = '-'
end
object MMFileSaveAs: TMenuItem
Caption = 'Save as ...'
end
object MMFileSep3: TMenuItem
Caption = '-'
end
object MMFileExit: TMenuItem
Caption = 'E&xit'
OnClick = ExitApplication
end
end
object MainMenuEdit: TMenuItem
Caption = 'Edit'
object MMeditUndo: TMenuItem
Caption = 'Undo'
ShortCut = 16474
Visible = False
end
object MMEditSep1: TMenuItem
Caption = '-'
Visible = False
end
object MMEditCut: TMenuItem
Caption = 'Cut'
ShortCut = 16472
Visible = False
end
object MMEditCopy: TMenuItem
Caption = 'Copy'
ShortCut = 16451
Visible = False
end
object MMEditPaste: TMenuItem
Caption = 'Paste'
ShortCut = 16470
Visible = False
end
object MMEditDelete: TMenuItem
Caption = 'Delete'
Visible = False
end
object MMEditSep2: TMenuItem
Caption = '-'
Visible = False
end
object MMEditSelAll: TMenuItem
Caption = 'Select All'
ShortCut = 16449
OnClick = SelectAllFunctions
end
object MMEditClearSel: TMenuItem
Caption = 'Clear Selection'
OnClick = DeselectAllFunctions
end
object MMEditCheckSel: TMenuItem
Caption = 'Check Selected'
Visible = False
end
object MMeditUnCheckSel: TMenuItem
Caption = 'Un-check Selected'
Visible = False
end
object MMEditSep3: TMenuItem
Caption = '-'
Visible = False
end
object MMEditAddAnsiFunction: TMenuItem
Caption = 'Add ANSI Function Name'
Visible = False
end
object MMEditAddWCHARFunctionName: TMenuItem
Caption = 'Add WCHAR Function Name'
Visible = False
end
object MMEditAddBothBunctkionNames: TMenuItem
Caption = 'Add Both'
Visible = False
end
object MMEditSep4: TMenuItem
Caption = '-'
end
object MMEditFind: TMenuItem
Caption = 'Find ...'
ShortCut = 16454
OnClick = FindText
end
object MMEditFindNext: TMenuItem
Caption = 'Find Next'
ShortCut = 114
end
end
object MainMenuView: TMenuItem
Caption = 'View'
Visible = False
end
object MainMenuOptions: TMenuItem
Caption = 'Options'
Visible = False
end
object MainMenuHelp: TMenuItem
Caption = 'Help'
Visible = False
object MMHelpHelp: TMenuItem
Caption = 'Help'
ShortCut = 112
end
object MMHelpSeparator1: TMenuItem
Caption = '-'
end
object MMHelpAbout: TMenuItem
Caption = 'About ...'
end
end
end
object OpenDialog1: TOpenDialog
FileName = 'ShlWAPI.dll'
Filter = 'Dynamic link libraries (*.dll)|*.dll|All files (*.*)|*.*'
Left = 516
end
object SaveDialog1: TSaveDialog
DefaultExt = 'txt'
Filter =
'Text (*.txt)|*.txt|Text (comma delimited)(*.csv)|*.csv|All Files' +
' (*.*)|*.*'
Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
Left = 323
Top = 42
end
object FindDialog1: TFindDialog
OnFind = OnFindDialogFind
Left = 191
Top = 30
end
end |
| |
Download file
|
|
|
| Application Manifest File |
| |
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="1.0.0.0" processorArchitecture="X86" name="SST.TestShlWAPIFunctions3" type="win32"/>
<description>ShlWAPI.dll Function Usage Application.</description>
<!--- Comment -->
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly> |
| |
Download file
|
|
|
| Resource Script File |
| |
/*****************************************************************************/
/* UNIT TestShlWAPIFunctions3.rc */
/* */
/* Author: Dominic Stoelzel */
/* Version : 1.01 */
/* Created : April 08, 2016 */
/* Last modified : February 23, 2017 17:15 (ds) */
/* */
/* Description of contents : Resource definition file for the SST */
/* ShlWAPI.dll function test application. */
/* */
/* */
/* Note : */
/* */
/* */
/*****************************************************************************/
//
//Demo Grahics
//
//LANGUAGE 0x09, 0x01
MAINICONGIF GIF ".\\Delphi5Ico.gif"
//
// Manifest resources
//
//LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US
LANGUAGE 0x09, 0x01
1 24 "TestShlWAPIFunctions3.xml"
|
| |
Download file
|
|
MyExampleDll01 Example Project
The MyExampleDll01 project consists of the SST recommendation for
an enhanced implementation of the DllGetVersionInfo function.
It produces a (delay load) dll that exports, exclusively, this, one function.
The function is called from the TestShlWAPIFunctions3 application, whenever the
DllGetVersionInfo ListView item is checked and the (ShlWAPI.dll)
functions test is run.
|
| Project File List |
| |
| File Type: |
File Name: |
| Delphi 5 Project Configuration File (.cfg): |
MyExampleDll01.cfg |
| Delphi 5 Options File (.dof): |
MyExampleDll01.dof |
| Delphi 5 Project File (.dpr): |
MyExampleDll01.dpr |
| Delphi 5 Unit (.pas): |
DllGetVerExample01.pas |
| Compiled Resource File (.res): |
MyExampleDll01.res |
|
| |
Download file
|
|
|
| Project Configuration File |
| |
-$A+
-$B+
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O-
-$P+
-$Q+
-$R+
-$S-
-$T-
-$U+
-$V-
-$W-
-$X+
-$Y+
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H-
-W+
-M
-$M16384,1048576
-K$00400000
-E"Exe\"
-N"Lib\"
-LE"..\Libraries\Packages"
-LN"..\Libraries\Packages"
-U"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;"
-O"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;"
-I"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;"
-R"c:\program files\borland\delphi5\Lib\Debug;c:\program files\borland\delphi5\Projects\Pas;c:\program files\borland\delphi5\Projects\Lib;Pas;Lib;" |
| |
Download file
|
|
|
| Delphi Options File |
| |
[Compiler]
A=1
B=1
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=0
P=1
Q=1
R=1
S=0
T=0
U=1
V=0
W=0
X=1
Y=2
Z=1
ShowHints=0
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=Exe\
UnitOutputDir=Lib\
PackageDLLOutputDir=Packages\
PackageDCPOutputDir=Packages\
SearchPath=$(DELPHI)\Lib\Debug;$(DELPHI)\Projects\Pas;$(DELPHI)\Projects\Lib;Pas;Lib;
Packages=Vcl50;Vclx50;VclSmp50;Vcldb50;Vclbde50;vcldbx50;VCLIB50;vclie50;dclocx50;dclaxserver50;
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Stoelzel Software Technologie (SST)
FileDescription=DllGetVersion usage and demo dynamic link library.
FileVersion=1.0.0.0
InternalName=MyExampleDll01.dll
LegalCopyright=Stoelzel Software Technologie (SST) 2017
LegalTrademarks=
OriginalFilename=MyExampleDll01.dll
ProductName=(SST) ShlWAPI.pas Version 1.08
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
$(DELPHI)\Extras\NetManage\DCLISP20.BPL=Borland Internet Solutions Pack Components (2.0 Compatability)
$(DELPHI)\Bin\dclite50.bpl=Borland Integrated Translation Environment
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=1
Item0=$(DELPHI)\Lib\Debug;$(DELPHI)\Projects\Pas;$(DELPHI)\Projects\Lib
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=Lib\
[HistoryLists\hlOutputDirectorry]
Count=1
Item0=Exe\
[HistoryLists\hlBPLOutput]
Count=0
[HistoryLists\hlDCPOutput]
Count=0 |
| |
Download file
|
|
|
| Project Source Code |
| |
library MyExampleDll01;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
DllGetVerExample01 in 'Pas\DllGetVerExample01.pas';
{$R *.RES}
EXPORTS
DllGetVersion;
begin
end. |
| |
Download file
|
|
|
| DllGetVersion Example Unit |
| |
{*****************************************************************************}
{ UNIT DllGetVerExample01.pas }
{ Copyright © Stoelzel Software Technologie 2004 - 2016 }
{ }
{ Author: Dominic Stoelzel }
{ Version : 1.00 }
{ Created : 06 October 2016 }
{ Last modified : 06 October 2016, 04:25 (ds) }
{ }
{ Description of contents : Source code unit that provides an example }
{ implmentation of a DllGetVersion function. }
{ }
{ Note : . }
{ }
{*****************************************************************************}
unit DllGetVerExample01;
interface
USES Windows, SyncObjs, ShlWAPI;
const MYDLL_MAJORVERSION = 1;
const MYDLL_MINORVERSION = 0;
const MYDLL_BUILDNUM = 42;
const MYDLL_PLATFORMIDWIN9X = DLLVER_PLATFORM_WINDOWS; //$00000001;
const MYDLL_PLATFORMIDWINNT = DLLVER_PLATFORM_NT; //$00000002;
const MYDLL_QFE = 88;
FUNCTION DllGetVersion(dllversioninfop : PDllVersionInfo) : HRESULT; STDCALL; FORWARD;
FUNCTION DllRetVersionInfo(dllversioninfop : PDllVersionInfo) : HRESULT; FORWARD;
implementation
Function DllGetVersion(dllversioninfop : PDllVersionInfo) : HRESULT;
Var retval : HRESULT;
Var critsection : TCriticalSection;
Begin
retval := 0; //= S_OK
critsection := NIL;
Try
critsection := TCriticalSection.Create();
Try
critsection.Enter();
retval := DllRetVersionInfo(dllversioninfop);
critsection.Leave();
Finally
critsection.Free();
end;
Except
raise;
end;
DllGetVersion := retval;
End;
Function DllRetVersionInfo(dllversioninfop : PDllVersionInfo) : HRESULT;
Var retval : HRESULT;
begin
retval := 0; //= S_OK
if dllversioninfop <> NIL then
begin
//Make sure that we have write access to at least the cbSize member
//so we can return the number of available bytes to the caller.
if IsBadWritePtr(dllversioninfop, SizeOf(DWORD)) = FALSE then
begin
if dllversioninfop^.cbSize >= SizeOf(TDllVersionInfo) then
begin
if IsBadWritePtr(dllversioninfop, SizeOf(TDllVersionInfo)) = FALSE then
begin
dllversioninfop^.dwMajorVersion := MYDLL_MAJORVERSION;
dllversioninfop^.dwMinorVersion := MYDLL_MINORVERSION;
dllversioninfop^.dwBuildNumber := MYDLL_BUILDNUM;
//If the dll was built for and requires Windows NT
//dllversioninfop^.dwPlatformID := MYDLL_PLATFORMIDWINNT;
//else //othervise
dllversioninfop^.dwPlatformID := MYDLL_PLATFORMIDWIN9X;
end
else
retval := $80070057; //= $80070000 + ERROR_INVALID_PARAMETER or ERROR_NOACCESS (= 998)
if (retval = S_OK) and (dllversioninfop^.cbSize = SizeOf(TDllVersionInfo2)) then
begin
if IsBadWritePtr(dllversioninfop, SizeOf(TDllVersionInfo2)) = FALSE then
begin
PDllVersionInfo2(dllversioninfop)^.dwFlags := 0;
PDllVersionInfo2(dllversioninfop)^.ullVersion := Int64(MakeDllVerULL(MYDLL_MAJORVERSION,
MYDLL_MINORVERSION,
MYDLL_BUILDNUM,
MYDLL_QFE));
end
else
retval := $80070057; //= $80070000 + ERROR_MORE_DATA or ERROR_NOACCESS (= 998)
end
end
else
begin
//If we've been passed an unitialized record
//(i.e. the cbSize member is 0 or smaller than 20 bytes)
//return the number of available bytes in cbSize and an
//error code.
dllversioninfop^.cbSize := SizeOf(TDllVersionInfo2);
retval := $800700EA; //ERROR_MORE_DATA (= 234) or ERROR_INSUFFICIENT_BUFFER (= 122)
end;
end
else
retval := $80070057; //= $80070000 + ERROR_INVALID_PARAMETER;
end
else
retval := $80070057; //= $80070000 + ERROR_INVALID_PARAMETER;
DllRetVersionInfo := retval;
end;
end. |
| |
Download file
|
|
|
|
